doctest-mode.el

;;; doctest-mode.el --- Major mode for editing Python doctest files

;; Copyright (C) 2004  Edward Loper

;; Author:     Edward Loper
;; Maintainer: edloper@alum.mit.edu
;; Created:    Aug 2004
;; Keywords:   python doctest unittest test docstring

(defconst doctest-version "0.2"
  "`doctest-mode' version number.")

;; This software is provided as-is, without express or implied
;; warranty.  Permission to use, copy, modify, distribute or sell this
;; software, without fee, for any purpose and by any individual or
;; organization, is hereby granted, provided that the above copyright
;; notice and this paragraph appear in all copies.

;; This is a major mode for editing text files that contain Python
;; doctest examples.  Doctest is a testing framework for Python that
;; emulates an interactive session, and checks the result of each
;; command.  For more information, see the Python library reference:
;; <http://docs.python.org/lib/module-doctest.html>

;; Known bugs:
;; - Some places assume prompts are 4 chars (but they can be 3
;;   if they're bare).
;; - String literals are not colored correctly.  (We need to color
;;   string literals on source lines, but *not* output lines or
;;   text lines; this is hard to do.)
;; - Output lines starting with "..." are mistakenly interpreted
;;   as (continuation) source lines.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Customizable Constants
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defgroup doctest nil
  "Support for the Python doctest framework"
  :group 'languages
  :prefix "doctest-")

(defcustom doctest-default-margin 4
  "The default pre-prompt margin for doctest examples."
  :type 'integer
  :group 'doctest)

(defcustom doctest-avoid-trailing-whitespace t
  "If true, then delete trailing whitespace when inserting a newline."
  :type 'boolean
  :group 'doctest)

(defcustom doctest-temp-directory
  (let ((ok '(lambda (x)
	       (and x
		    (setq x (expand-file-name x)) ; always true
		    (file-directory-p x)
		    (file-writable-p x)
		    x))))
    (or (funcall ok (getenv "TMPDIR"))
	(funcall ok "/usr/tmp")
	(funcall ok "/tmp")
	(funcall ok "/var/tmp")
	(funcall ok  ".")
	(error (concat "Couldn't find a usable temp directory -- "
		       "set `doctest-temp-directory'"))))
	 
  "*Directory used for temporary files created when running doctest.
By default, the first directory from this list that exists and that you
can write into: the value (if any) of the environment variable TMPDIR,
/usr/tmp, /tmp, /var/tmp, or the current directory."
  :type 'string
  :group 'doctest)

(defcustom hide-example-source t
  "If true, then don't display the example source code for each 
failure in the results buffer."
  :type 'boolean
  :group 'doctest)

(defcustom doctest-python-command "python"
  "Shell command used to start the python interpreter")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Fonts
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defface doctest-prompt-face
  '((((class color) (background dark))
     (:foreground "#68f"))
    (t (:foreground "#226")))
  "Face for Python prompts in doctest examples."
  :group 'doctest)

(defface doctest-output-face
  '((((class color) (background dark))
     (:foreground "#afd"))
    (t (:foreground "#262")))
  "Face for the output of doctest examples."
  :group 'doctest)

(defface doctest-output-marker-face
  '((((class color) (background dark))
     (:foreground "#0f0"))
    (t (:foreground "#080")))
  "Face for markers in the output of doctest examples."
  :group 'doctest)

(defface doctest-output-traceback-face
  '((((class color) (background dark))
     (:foreground "#f88"))
    (t (:foreground "#622")))
  "Face for traceback headers in the output of doctest examples."
  :group 'doctest)

(defface doctest-results-divider-face
  '((((class color) (background dark))
     (:foreground "#08f"))
    (t (:foreground "#00f")))
  "Face for dividers in the doctest results window."
  :group 'doctest)

(defface doctest-results-loc-face
  '((((class color) (background dark))
     (:foreground "#0f8"))
    (t (:foreground "#084")))
  "Face for location headers in the doctest results window."
  :group 'doctest)

(defface doctest-results-header-face
  '((((class color) (background dark))
     (:foreground "#8ff"))
    (t (:foreground "#088")))
  "Face for sub-headers in the doctest results window."
  :group 'doctest)

(defface doctest-results-selection-face
  '((((class color) (background dark))
     (:foreground "#ff0" :background "#008"))
    (t (:background "#088" :foreground "#fff")))
  "Face for selected failure's location header in the results window."
  :group 'doctest)

(defface doctest-selection-face
  '((((class color) (background dark))
     (:foreground "#ff0" :background "#00f" :bold t))
    (t (:foreground "#f00")))
  "Face for selected example's prompt"
  :group 'doctest)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Constants
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defconst doctest-prompt-re
  "^\\([ \t]*\\)\\(>>> ?\\|[.][.][.] ?\\)\\([ \t]*\\)"
  "Regular expression for doctest prompts.  It defines three groups:
the pre-prompt margin; the prompt; and the post-prompt indentation.")

(defconst doctest-open-block-re
  "[^\n]+:[ \t]*\\(#.*\\)?$"
  "Regular expression for a line that opens a block")

(defconst doctest-close-block-re
  "\\(return\\|raise\\|break\\|continue\\|pass\\)\\b"
  "Regular expression for a line that closes a block")

(defconst doctest-outdent-re
  (concat "\\(" (mapconcat 'identity
			   '("else:"
			     "except\\(\\s +.*\\)?:"
			     "finally:"
			     "elif\\s +.*:")
			   "\\|")
	  "\\)")
  "Regular expression for a line that should be outdented.  Any line
that matches `doctest-outdent-re', but does not follow a line matching
`doctest-no-outdent-re', will be outdented.")

(defconst doctest-no-outdent-re
  (concat
   "\\("
   (mapconcat 'identity
	      (list "try:"
		    "except\\(\\s +.*\\)?:"
		    "while\\s +.*:"
		    "for\\s +.*:"
		    "if\\s +.*:"
		    "elif\\s +.*:"
                    "\\(return\\|raise\\|break\\|continue\\|pass\\)[ \t\n]"
		    )
	      "\\|")
	  "\\)")
  "Regular expression matching lines not to outdent after.  Any line
that matches `doctest-outdent-re', but does not follow a line matching
`doctest-no-outdent-re', will be outdented.")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Colorization support (font-lock mode)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Define the font-lock keyword table.
(defconst doctest-font-lock-keywords
  (let ((prompt "^[ \t]*\\(>>>\\|\\.\\.\\.\\)")
        (kw1 (mapconcat 'identity
			'("and"      "assert"   "break"   "class"
			  "continue" "def"      "del"     "elif"
			  "else"     "except"   "exec"    "for"
			  "from"     "global"   "if"      "import"
			  "in"       "is"       "lambda"  "not"
			  "or"       "pass"     "print"   "raise"
			  "return"   "while"    "yield"
			  )
			"\\|"))
	(kw2 (mapconcat 'identity
			'("else:" "except:" "finally:" "try:")
			"\\|"))
	(kw3 (mapconcat 'identity
			'("ArithmeticError" "AssertionError"
			  "AttributeError" "DeprecationWarning" "EOFError"
			  "Ellipsis" "EnvironmentError" "Exception" "False"
			  "FloatingPointError" "FutureWarning" "IOError"
			  "ImportError" "IndentationError" "IndexError"
			  "KeyError" "KeyboardInterrupt" "LookupError"
			  "MemoryError" "NameError" "None" "NotImplemented"
			  "NotImplementedError" "OSError" "OverflowError"
			  "OverflowWarning" "PendingDeprecationWarning"
			  "ReferenceError" "RuntimeError" "RuntimeWarning"
			  "StandardError" "StopIteration" "SyntaxError"
			  "SyntaxWarning" "SystemError" "SystemExit"
			  "TabError" "True" "TypeError" "UnboundLocalError"
			  "UnicodeDecodeError" "UnicodeEncodeError"
			  "UnicodeError" "UnicodeTranslateError"
			  "UserWarning" "ValueError" "Warning"
			  "ZeroDivisionError" "__debug__"
			  "__import__" "__name__" "abs" "apply" "basestring"
			  "bool" "buffer" "callable" "chr" "classmethod"
			  "cmp" "coerce" "compile" "complex" "copyright"
			  "delattr" "dict" "dir" "divmod"
			  "enumerate" "eval" "execfile" "exit" "file"
			  "filter" "float" "getattr" "globals" "hasattr"
			  "hash" "hex" "id" "input" "int" "intern"
			  "isinstance" "issubclass" "iter" "len" "license"
			  "list" "locals" "long" "map" "max" "min" "object"
			  "oct" "open" "ord" "pow" "property" "range"
			  "raw_input" "reduce" "reload" "repr" "round"
			  "setattr" "slice" "staticmethod" "str" "sum"
			  "super" "tuple" "type" "unichr" "unicode" "vars"
			  "xrange" "zip")
			"\\|"))
        (pseudokw (mapconcat 'identity
                        '("self" "None" "True" "False" "Ellipsis")
                        "\\|"))
        (brk "\\([ \t(]\\|$\\)")
	)
    `(
      ;; The following pattern colorizes source lines.  In particular,
      ;; it first matches prompts, and then looks for any of the
      ;; following matches *on the same line* as the prompt.  It uses
      ;; the form:
      ;;
      ;;   (MATCHER MATCH-HIGHLIGHT
      ;;            (ANCHOR-MATCHER nil nil MATCH-HIGHLIGHT)
      ;;            ...
      ;;            (ANCHOR-MATCHER nil nil MATCH-HIGHLIGHT))
      ;;
      ;; See the variable documentation for font-lock-keywords for a
      ;; description of what each of those means.
      (,prompt (1 'doctest-prompt-face)
               ;; classes
               ("\\b\\(class\\)[ \t]+\\([a-zA-Z_]+[a-zA-Z0-9_]*\\)"
                nil nil (1 'font-lock-keyword-face)
                (2 'font-lock-type-face))
               ;; functions
               ("\\b\\(def\\)[ \t]+\\([a-zA-Z_]+[a-zA-Z0-9_]*\\)"
                nil nil (1 'font-lock-keyword-face) (2 'font-lock-type-face))
               ;; keywords
               (,(concat "\\b\\(" kw1 "\\)" brk)
                nil nil (1 'font-lock-keyword-face))
               ;; builtins when they don't appear as object attributes
               (,(concat "\\(\\b\\|[.]\\)\\(" kw3 "\\)" brk)
                nil nil (2 'font-lock-keyword-face))
               ;; block introducing keywords with immediately
               ;; following colons.  Yes "except" is in both lists.
               (,(concat "\\b\\(" kw2 "\\)" brk)
                nil nil (1 'font-lock-keyword-face))
               ;; `as' but only in "import foo as bar"
               ("[ \t]*\\(\\bfrom\\b.*\\)?\\bimport\\b.*\\b\\(as\\)\\b"
                nil nil (2 'font-lock-keyword-face))
               ;; pseudo-keywords
               (,(concat "\\b\\(" pseudokw "\\)" brk)
                nil nil (1 'font-lock-keyword-face))
               ;; comments
               ("\\(#.*\\)"
                nil nil (1 'font-lock-comment-face)))

      ;; The following pattern colorizes output lines.  In particular,
      ;; it uses doctest-output-line-matcher to check if this is an
      ;; output line, and if so, it colorizes it, and any special
      ;; markers it contains.
      (doctest-output-line-matcher
       (0 'doctest-output-face t)
       ("\\.\\.\\." (beginning-of-line) (end-of-line)
	(0 'doctest-output-marker-face t))
       ("<BLANKLINE>" (beginning-of-line) (end-of-line)
	(0 'doctest-output-marker-face t))
       ("^Traceback (most recent call last):" (beginning-of-line) (end-of-line)
	(0 'doctest-output-traceback-face t))
       ("^Traceback (innermost last):" (beginning-of-line) (end-of-line)
	(0 'doctest-output-traceback-face t))
       )

      ;; A PS1 prompt followed by a non-space is an error.
      ("^[ \t]*\\(>>>[^ \t\n][^\n]*\\)" (1 'font-lock-warning-face t))

      ;; Selected example (to highlight selected failure)
      (doctest-selection-matcher (0 'doctest-selection-face t))
      ))
  "Expressions to highlight in Doctest mode.")

(defun doctest-output-line-matcher (limit)
  "A `font-lock-keyword' MATCHER that returns t if the current 
line is the expected output for a doctest example, and if so, 
sets `match-data' so that group 0 spans the current line."
  ;; The real work is done by find-doctest-output-line.
  (when (find-doctest-output-line limit)
    ;; If we found one, then mark the entire line.
    (beginning-of-line)
    (search-forward-regexp "[^\n]*" limit)))

;; [XX] Under construction.
(defun doctest-selection-matcher (limit)
  (let (found-it)
    (while (and (not found-it) 
                (search-forward-regexp "^[ \t]*\\(>>>\\|[.][.][.]\\)"
                                       limit t))
      (if (get-text-property (point) 'doctest-selected)
          (setq found-it t)))
    found-it))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Source line indentation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun doctest-indent-source-line (&optional dedent-only)
  "Re-indent the current line, as doctest source code.  I.e., add a
prompt to the current line if it doesn't have one, and re-indent the
source code (to the right of the prompt).  If `dedent-only' is true,
then don't increase the indentation level any."
  (interactive "*")
  (let ((indent-end nil))
    (save-excursion
      (beginning-of-line)
      (let ((new-indent (doctest-current-source-line-indentation dedent-only))
            (new-margin (doctest-current-source-line-margin))
            (line-had-prompt (looking-at doctest-prompt-re)))
        ;; Delete the old prompt (if any).
        (when line-had-prompt
          (goto-char (match-end 1))
          (delete-char 4))
        ;; Delete the old indentation.
        (delete-backward-char (skip-chars-forward " \t"))
        ;; If it's a continuation line, or a new PS1 prompt,
        ;; then copy the margin.
        (when (or new-indent (not line-had-prompt))
          (beginning-of-line)
          (delete-backward-char (skip-chars-forward " \t"))
          (insert-char ?\  new-margin))
        ;; Add the new prompt.
        (insert-string (if new-indent "... " ">>> "))
        ;; Add the new indentation
        (if new-indent (insert-char ?\  new-indent))
        (setq indent-end (point))))
    ;; If we're left of the indentation end, then move up to the
    ;; indentation end.
    (if (< (point) indent-end) (goto-char indent-end))))

(defun doctest-current-source-line-indentation (&optional dedent-only)
  "Return the post-prompt indent to use for this line.  This is an
integer for a continuation lines, and nil for non-continuation lines."
  (save-excursion
    (let ((prev-line-indent 0)
          (curr-line-indent 0)
          (prev-line-opens-block nil)
          (prev-line-closes-block nil)
          (curr-line-outdented nil))
      ;; Examine this doctest line.
      (beginning-of-line)
      (when (looking-at doctest-prompt-re)
          (setq curr-line-indent (- (match-end 3) (match-beginning 3)))
	  (goto-char (match-end 3)))
      (setq curr-line-outdented (looking-at doctest-outdent-re))
      ;; Examine the previous line.
      (when (= (forward-line -1) 0) ; move up a line
	(when (looking-at doctest-prompt-re) ; is it a source line?
	  (let ((indent-beg (column-at-char (match-beginning 3)))
		(indent-end (column-at-char (match-end 3))))
	    (setq prev-line-indent (- indent-end indent-beg))
	    (goto-char (match-end 3))
	    (if (looking-at doctest-open-block-re)
		(setq prev-line-opens-block t))
	    (if (looking-at doctest-close-block-re)
		(setq prev-line-closes-block t))
	    (if (looking-at doctest-no-outdent-re)
		(setq curr-line-outdented nil))
	    )))
      (let ((indent (+ prev-line-indent
                       (if curr-line-outdented -4 0)
                       (if prev-line-opens-block 4 0)
                       (if prev-line-closes-block -4 0))))
	;; If dedent-only is true, then make sure we don't indent.
	(when dedent-only 
	  (setq indent (min indent curr-line-indent)))
	;; If indent=0 and we're not outdented, then set indent to
	;; nil (to signify the start of a new source example).
	(when (and (= indent 0) (not curr-line-outdented))
	  (setq indent nil))
	;; Return the indentation.
	indent))))

(defun doctest-current-source-line-margin ()
  "Return the pre-prompt margin to use for this source line.  This is
copied from the most recent source line, or set to
`doctest-default-margin' if there are no preceeding source lines."
  (save-excursion
    (beginning-of-line)
    (if (search-backward-regexp doctest-prompt-re nil t)
        (let ((margin-beg (column-at-char (match-beginning 1)))
              (margin-end (column-at-char (match-end 1))))
          (- margin-end margin-beg))
      doctest-default-margin)))

(defun doctest-electric-backspace ()
  "Delete the preceeding character, level of indentation, or
prompt.  

If point is at the leftmost column, delete the preceding newline.

Otherwise, if point is at the first non-whitespace character
following an indented source line's prompt, then reduce the
indentation to the next multiple of 4; and update the source line's
prompt, when necessary.

Otherwise, if point is at the first non-whitespace character
following an unindented source line's prompt, then remove the
prompt (converting the line to an output line or text line).

Otherwise, if point is at the first non-whitespace character of a
line, the delete the line's indentation.

Otherwise, delete the preceeding character.
"
  (interactive "*")
  (cond 
   ;; Beginning of line: delete preceeding newline.
   ((bolp) (backward-delete-char 1))
      
   ;; First non-ws char following prompt: dedent or remove prompt.
   ((and (looking-at "[^ \t\n]\\|$") (doctest-looking-back doctest-prompt-re))
    (let* ((prompt-beg (match-beginning 2))
	   (indent-beg (match-beginning 3)) (indent-end (match-end 3))
	   (old-indent (- indent-end indent-beg))
	   (new-indent (* (/ (- old-indent 1) 4) 4)))
      (cond
       ;; Indented source line: dedent it.
       ((> old-indent 0)
	(goto-char indent-beg)
	(delete-region indent-beg indent-end)
	(insert-char ?\  new-indent)
	;; Change prompt to PS1, when appropriate.
	(when (and (= new-indent 0) (not (looking-at doctest-outdent-re)))
	  (delete-backward-char 4)
	  (insert-string ">>> ")))
       ;; Non-indented source line: remove prompt.
       (t
	(goto-char indent-end)
	(delete-region prompt-beg indent-end)))))

   ;; First non-ws char of a line: delete all indentation.
   ((and (looking-at "[^ \n\t]\\|$") (doctest-looking-back "^[ \t]+"))
    (delete-region (match-beginning 0) (match-end 0)))

   ;; Otherwise: delete a character.
   (t
    (backward-delete-char 1))))

(defun doctest-newline-and-indent ()
  "Insert a newline, and indent the new line appropriately.

If the current line is a source line containing a bare prompt,
then clear the current line, and insert a newline.

Otherwise, if the current line is a source line, then insert a
newline, and add an appropriately indented prompt to the new
line.

Otherwise, if the current line is an output line, then insert a
newline and indent the new line to match the example's margin.

Otherwise, insert a newline.

If `doctest-avoid-trailing-whitespace' is true, then clear any
whitespace to the left of the point before inserting a newline.
"
  (interactive "*")
  ;; If we're avoiding trailing spaces, then delete WS before point.
  (if doctest-avoid-trailing-whitespace
      (delete-char (- (skip-chars-backward " \t"))))     
  (cond 
   ;; If we're on an empty prompt, delete it.
   ((on-empty-doctest-source-line)
    (delete-region (match-beginning 0) (match-end 0))
    (insert-char ?\n 1))
   ;; If we're on a doctest line, add a new prompt.
   ((on-doctest-source-line)
    (insert-char ?\n 1)
    (doctest-indent-source-line))
   ;; If we're in doctest output, indent to the margin.
   ((on-doctest-output-line)
    (insert-char ?\n 1)
    (insert-char ?\  (doctest-current-source-line-margin)))
   ;; Otherwise, just add a newline.
   (t (insert-char ?\n 1))))

(defun doctest-electric-colon ()
  "Insert a colon, and dedent the line when appropriate."
  (interactive "*")
  (insert-char ?: 1)
  (when (on-doctest-source-line)
    (doctest-indent-source-line t)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Code Execution
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Add support for options (eg diff!)
(defun doctest-execute-buffer ()
  "Run doctest on the current buffer, and display the results in the 
*doctest-output* buffer."
  (interactive "*")
  (setq doctest-results-buffer (get-buffer-create "*doctest-output*"))
  (let* ((temp (concat (doctest-temp-name) ".py"))
	 (tempfile (expand-file-name temp doctest-temp-directory))
	 (cur-buf (current-buffer))
	 (in-buf (get-buffer-create "*doctest-input*"))
	 (beg (point-min)) (end (point-max))
	 (script (concat "from doctest import *\n"
			 "doc = open('" tempfile "').read()\n"
			 "test = DocTestParser().get_doctest("
			         "doc, {}, '" (buffer-name) "', '"
				 (buffer-file-name) "', 0)\n"
			 "r = DocTestRunner()\n"
			 "r.run(test)\n"))
	 (cmd (concat doctest-python-command " -c \"" script "\"")))
    ;; Write buffer to a file.
    (save-excursion
      (set-buffer in-buf)
      (insert-buffer-substring cur-buf beg end)
      (write-file tempfile))
    ;; Run doctest
    (shell-command cmd doctest-results-buffer)
    ;; Delete the temp file
    (delete-file tempfile)
    ;; Set mode on output buffer.
    (save-excursion
      (set-buffer doctest-results-buffer)
      (doctest-results-mode))
    ;; If any tests failed, display them.
    (cond ((> (buffer-size doctest-results-buffer) 0)
	   (message "Test failed!")
	   (display-buffer doctest-results-buffer)
	   (doctest-postprocess-results))
	  (t
	   (message "Test passed!")
	   (if (get-buffer-window doctest-results-buffer)
	       (delete-window (get-buffer-window doctest-results-buffer)))))))

(defun doctest-postprocess-results ()
  (doctest-next-failure 1)
  (if hide-example-source
    (hide-example-source)))

(defun doctest-next-failure (count)
  "Move to the top of the next failing example, and highlight the
example's failure description in *doctest-output*."
  (interactive "p")
  (let (lineno)
    (cond
     ((not (buffer-live-p doctest-results-buffer))
      (message "Run doctest first! (C-c C-c)"))
     (t
      (save-excursion
        (let ((orig-window (selected-window))
              (results-window (display-buffer doctest-results-buffer)))
          ;; Switch to the results window (so its point gets updated)
          (if results-window (select-window results-window))
          ;; Pick up where we left off.
          ;; (nb: doctest-selected-failure is buffer-local)
          (goto-char (or doctest-selected-failure (point-min)))
          ;; Skip past anything on *this* line.
          (if (>= count 0) (end-of-line) (beginning-of-line))
          ;; Look for the next failure
          (if (>= count 0)
              (re-search-forward doctest-results-loc-re nil t count)
            (re-search-backward doctest-results-loc-re nil t (- count)))
          (cond
           ;; We found a failure:
           ((match-string 2)
            (let ((old-selected-failure doctest-selected-failure))
              ;; Extract the line number for the doctest file.
              (setq lineno (string-to-int (match-string 2)))
              ;; Store our position for next time.
              (beginning-of-line)
              (setq doctest-selected-failure (point))
              ;; Update selection.
              (doctest-fontify-line old-selected-failure)
              (doctest-fontify-line doctest-selected-failure)))
           ;; We didn't find a failure:
           (t
            (message "No failures found!")))
          ;; Return to the original window
          (select-window orig-window)))))

    (when lineno
      ;; Move point to the selected failure.
      (goto-line lineno)
;      ;; Highlight it. [XX] Under construction.
;      (let ((beg (save-excursion (beginning-of-line) (point)))
;            (end (save-excursion (end-of-line) (point))))
;        (add-text-properties (point-min) (point-max) '(doctest-selected nil))
;        (add-text-properties beg end '(doctest-selected t))
;        (doctest-fontify-line (point)))
      )))

(defun doctest-prev-failure (count)
  "Move to the top of the previous failing example, and highlight
the example's failure description in *doctest-output*."
  (interactive "p")
  (doctest-next-failure (- count)))

(defun doctest-first-failure ()
  (interactive "")
  (if (buffer-live-p doctest-results-buffer)
      (save-excursion
        (set-buffer doctest-results-buffer)
        (let ((old-selected-failure doctest-selected-failure))
          (setq doctest-selected-failure (point-min))
          (doctest-fontify-line old-selected-failure))))
  (doctest-next-failure 1))

(defun doctest-last-failure ()
  (interactive "")
  (if (buffer-live-p doctest-results-buffer)
      (save-excursion
        (set-buffer doctest-results-buffer)
        (let ((old-selected-failure doctest-selected-failure))
          (setq doctest-selected-failure (point-max))
          (doctest-fontify-line old-selected-failure))))
  (doctest-next-failure -1))

(defconst doctest-example-source-re 
  "^Failed example:\n\\(\n\\|    [^\n]*\n\\)+")
(defun hide-example-source ()
  "Delete the source code listings from the results buffer (since it's
easy enough to see them in the original buffer)"
  (save-excursion
    (set-buffer doctest-results-buffer)
    (toggle-read-only nil)
    (beginning-of-buffer)
    (while (re-search-forward doctest-example-source-re nil t)
      (replace-match "" nil nil))
    (toggle-read-only t)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Doctest Results Mode (output of doctest-execute-buffer)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; [XX] Todo:
;;   - Make it read-only?
;;   - Hitting enter goes to the corresponding error
;;   - Clicking goes to corresponding error (not as useful)


(defconst doctest-results-divider-re
  "^\\([*]\\{60,\\}\\)$")

(defconst doctest-results-loc-re
  "^File \"\\([^\"]+\\)\", line \\([0-9]+\\), in \\([^\n]+\\)")

(defconst doctest-results-header-re
  "^\\([a-zA-Z0-9 ]+:\\)$")

(defconst doctest-results-font-lock-keywords
  `((,doctest-results-divider-re 
     (0 'doctest-results-divider-face))
    (,doctest-results-loc-re 
     (0 'doctest-results-loc-face))
    (,doctest-results-header-re 
     (0 'doctest-results-header-face))
    (doctest-results-selection-matcher 
     (0 'doctest-results-selection-face t))))

(defun doctest-results-selection-matcher (limit)
  "Matches from `doctest-selected-failure' to the end of the
line.  This is used to highlight the currently selected failure."
  (when (and doctest-selected-failure
	     (<= (point) doctest-selected-failure)
	     (< doctest-selected-failure limit))
    (goto-char doctest-selected-failure)
    (search-forward-regexp "[^\n]+" limit)))

;; Register the font-lock keywords (xemacs)
(put 'doctest-results-mode 'font-lock-defaults 
     '(doctest-results-font-lock-keywords))

;; Register the font-lock keywords (gnu emacs)
(defvar font-lock-defaults-alist nil) ; in case we're in xemacs
(setq font-lock-defaults-alist
      (append font-lock-defaults-alist
              `((doctest-results-mode 
		 doctest-results-font-lock-keywords 
		 nil nil nil nil))))

;; Define the mode
(define-derived-mode doctest-results-mode text-mode "Doctest Results"
  "docstring"
  ;; Enable font-lock mode.
  (if (featurep 'font-lock) (font-lock-mode 1))
  ;; Keep track of which failure is selected
  (set (make-local-variable 'doctest-selected-failure) nil)
  ;; Make the buffer read-only.
  (toggle-read-only t))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Helper functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun on-doctest-source-line ()
  "Return true if the current line is a source line."
  (save-excursion
    (beginning-of-line)
    (looking-at doctest-prompt-re)))

(defun on-empty-doctest-source-line ()
  "Return true if the current line contains a bare prompt."
  (save-excursion
    (beginning-of-line)
    (looking-at (concat doctest-prompt-re "$"))))

(defun on-doctest-output-line ()
  "Return true if the current line is an output line."
  (save-excursion
    (beginning-of-line)
    (let ((prompt-or-blankline (concat doctest-prompt-re "\\|" "^[ \t]*\n")))
      ;; The line must not be blank or start with a prompt.
      (when (not (looking-at prompt-or-blankline))
          ;; The line must follow a line starting with a prompt, with
          ;; no intervening blank lines.
          (search-backward-regexp prompt-or-blankline nil t)
          (looking-at doctest-prompt-re)))))

(defun find-doctest-output-line (&optional limit)
  "Move forward to the next doctest output line (staying within
the given bounds).  Return the character position of the doctest
output line if one was found, and false otherwise."
  (let ((found-it nil) ; point where we found an output line
	(limit (or limit (point-max)))) ; default value for limit
    (save-excursion
      ;; Keep moving forward, one line at a time, until we find a
      ;; doctest output line.
      (while (and (not found-it) (< (point) limit) (not (eobp)))
	(if (and (not (eolp)) (on-doctest-output-line))
	    (setq found-it (point))
	  (forward-line))))
    ;; If we found a doctest output line, then go to it.
    (if found-it (goto-char found-it))))

(defun doctest-version ()
  "Echo the current version of `doctest-mode' in the minibuffer."
  (interactive)
  (message "Using `doctest-mode' version %s" doctest-version))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Utility functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar doctest-serial-number 0) ;used if broken-temp-names.
(defun doctest-temp-name ()
  (if (memq 'broken-temp-names features)
      (let
	  ((sn doctest-serial-number)
	   (pid (and (fboundp 'emacs-pid) (emacs-pid))))
	(setq doctest-serial-number (1+ doctest-serial-number))
	(if pid
	    (format "doctest-%d-%d" sn pid)
	  (format "doctest-%d" sn)))
    (make-temp-name "doctest-")))

(defun column-at-char (pos)
  "Return the column of the given character position"
  (save-excursion (goto-char pos) (current-column)))

(defun doctest-looking-back (regexp)
  "Return True if the text before point matches the given regular
expression.  Like looking-at except backwards and slower.  (This
is available as `looking-back' in GNU emacs and
`looking-at-backwards' in XEmacs, but it's easy enough to define
from scratch such that it works under both.)"
  (save-excursion
    (let ((orig-pos (point)))
      ;; Search backwards for the regexp.
      (if (re-search-backward regexp nil t)
	  ;; Check if it ends at the original point.
	  (= orig-pos (match-end 0))))))

(defun doctest-fontify-line (charpos)
  "Run font-lock-fontify-region on the line containing the given
position."
  (if charpos
      (save-excursion
        (goto-char charpos)
        (let ((beg (progn (beginning-of-line) (point)))
              (end (progn (end-of-line) (point))))
          (font-lock-fontify-region beg end)))))
  
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Syntax Table
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; We do *NOT* currently use this, because it applies too
;; indiscrimanantly.  In particular, we don't want "'" and '"' treated
;; as quote marks on text lines.  But there's no good way to prevent
;; it.
(defvar doctest-syntax-alist nil
  "Syntax alist used in `doctest-mode' buffers.")
(setq doctest-syntax-alist '((?\( . "()") (?\[ . "(]") (?\{ . "(}")
			     (?\) . ")(") (?\] . ")[") (?\} . "){")
			     (?\$ . "." ) (?\% . "." ) (?\& . "." )
			     (?\* . "." ) (?\+ . "." ) (?\- . "." )
			     (?\/ . "." ) (?\< . "." ) (?\= . "." )
			     (?\> . "." ) (?\| . "." ) (?\_ . "w" )
			     (?\' . "\"") (?\" . "\"") (?\` . "$" )
			     (?\# . "<" ) (?\n . ">" )))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Key Bindings
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defconst doctest-mode-map 
  (let ((map (make-keymap)))
    (define-key map [backspace] 'doctest-electric-backspace)
    (define-key map [return] 'doctest-newline-and-indent)
    (define-key map [tab] 'doctest-indent-source-line)
    (define-key map ":" 'doctest-electric-colon)
    (define-key map "\C-c\C-v" 'doctest-version)
    (define-key map "\C-c\C-c" 'doctest-execute-buffer)
    (define-key map "\C-c\C-n" 'doctest-next-failure)
    (define-key map "\C-c\C-p" 'doctest-prev-failure)
    (define-key map "\C-c\C-a" 'doctest-first-failure)
    (define-key map "\C-c\C-z" 'doctest-last-failure)
    map) 
  "Keymap for doctest-mode.")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Define the mode
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Register the font-lock keywords (xemacs)
(put 'doctest-mode 'font-lock-defaults '(doctest-font-lock-keywords))

;; Register the font-lock keywords (gnu emacs)
(defvar font-lock-defaults-alist nil) ; in case we're in xemacs
(setq font-lock-defaults-alist
      (append font-lock-defaults-alist
              `((doctest-mode doctest-font-lock-keywords nil nil nil nil))))

;; Use doctest mode for files ending in .doctest
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.doctest$" . doctest-mode))

;;;###autoload
(define-derived-mode doctest-mode text-mode "Doctest"
  "A major mode for editing text files that contain Python
doctest examples.  Doctest is a testing framework for Python that
emulates an interactive session, and checks the result of each
command.  For more information, see the Python library reference:
<http://docs.python.org/lib/module-doctest.html>

`doctest-mode' defines three kinds of line, each of which is
treated differently:

  - 'Source lines' are lines consisting of a Python prompt
    ('>>>' or '...'), followed by source code.  Source lines are
    colored (similarly to `python-mode') and auto-indented.

  - 'Output lines' are non-blank lines immediately following
    source lines.  They are colored using several doctest-
    specific output faces.

  - 'Text lines' are any other lines.  They are not processed in
    any special way.

\\{doctest-mode-map}
"
  ;; Enable auto-fill mode.
  (auto-fill-mode 1)

  ;; Enable font-lock mode.
  (if (featurep 'font-lock) (font-lock-mode 1))
  
  ;; Register our indentation function.
  (set (make-local-variable 'indent-line-function) 
       'doctest-indent-source-line)

  ;; Keep track of our results buffer.
  (set (make-local-variable 'doctest-results-buffer) nil)
  )

(provide 'doctest-mode)
;;; doctest-mode.el ends here