attachment:doctest-mode.el of Emacs

   1 ;;; doctest-mode.el --- Major mode for editing Python doctest files
   2 
   3 ;; Copyright (C) 2004  Edward Loper
   4 
   5 ;; Author:     Edward Loper
   6 ;; Maintainer: [email protected]
   7 ;; Created:    Aug 2004
   8 ;; Keywords:   python doctest unittest test docstring
   9 
  10 (defconst doctest-version "0.2"
  11   "`doctest-mode' version number.")
  12 
  13 ;; This software is provided as-is, without express or implied
  14 ;; warranty.  Permission to use, copy, modify, distribute or sell this
  15 ;; software, without fee, for any purpose and by any individual or
  16 ;; organization, is hereby granted, provided that the above copyright
  17 ;; notice and this paragraph appear in all copies.
  18 
  19 ;; This is a major mode for editing text files that contain Python
  20 ;; doctest examples.  Doctest is a testing framework for Python that
  21 ;; emulates an interactive session, and checks the result of each
  22 ;; command.  For more information, see the Python library reference:
  23 ;; <http://docs.python.org/lib/module-doctest.html>
  24 
  25 ;; Known bugs:
  26 ;; - Some places assume prompts are 4 chars (but they can be 3
  27 ;;   if they're bare).
  28 ;; - String literals are not colored correctly.  (We need to color
  29 ;;   string literals on source lines, but *not* output lines or
  30 ;;   text lines; this is hard to do.)
  31 ;; - Output lines starting with "..." are mistakenly interpreted
  32 ;;   as (continuation) source lines.
  33 
  34 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  35 ;; Customizable Constants
  36 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  37 
  38 (defgroup doctest nil
  39   "Support for the Python doctest framework"
  40   :group 'languages
  41   :prefix "doctest-")
  42 
  43 (defcustom doctest-default-margin 4
  44   "The default pre-prompt margin for doctest examples."
  45   :type 'integer
  46   :group 'doctest)
  47 
  48 (defcustom doctest-avoid-trailing-whitespace t
  49   "If true, then delete trailing whitespace when inserting a newline."
  50   :type 'boolean
  51   :group 'doctest)
  52 
  53 (defcustom doctest-temp-directory
  54   (let ((ok '(lambda (x)
  55 	       (and x
  56 		    (setq x (expand-file-name x)) ; always true
  57 		    (file-directory-p x)
  58 		    (file-writable-p x)
  59 		    x))))
  60     (or (funcall ok (getenv "TMPDIR"))
  61 	(funcall ok "/usr/tmp")
  62 	(funcall ok "/tmp")
  63 	(funcall ok "/var/tmp")
  64 	(funcall ok  ".")
  65 	(error (concat "Couldn't find a usable temp directory -- "
  66 		       "set `doctest-temp-directory'"))))
  67 	 
  68   "*Directory used for temporary files created when running doctest.
  69 By default, the first directory from this list that exists and that you
  70 can write into: the value (if any) of the environment variable TMPDIR,
  71 /usr/tmp, /tmp, /var/tmp, or the current directory."
  72   :type 'string
  73   :group 'doctest)
  74 
  75 (defcustom hide-example-source t
  76   "If true, then don't display the example source code for each 
  77 failure in the results buffer."
  78   :type 'boolean
  79   :group 'doctest)
  80 
  81 (defcustom doctest-python-command "python"
  82   "Shell command used to start the python interpreter")
  83 
  84 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  85 ;; Fonts
  86 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  87 
  88 (defface doctest-prompt-face
  89   '((((class color) (background dark))
  90      (:foreground "#68f"))
  91     (t (:foreground "#226")))
  92   "Face for Python prompts in doctest examples."
  93   :group 'doctest)
  94 
  95 (defface doctest-output-face
  96   '((((class color) (background dark))
  97      (:foreground "#afd"))
  98     (t (:foreground "#262")))
  99   "Face for the output of doctest examples."
 100   :group 'doctest)
 101 
 102 (defface doctest-output-marker-face
 103   '((((class color) (background dark))
 104      (:foreground "#0f0"))
 105     (t (:foreground "#080")))
 106   "Face for markers in the output of doctest examples."
 107   :group 'doctest)
 108 
 109 (defface doctest-output-traceback-face
 110   '((((class color) (background dark))
 111      (:foreground "#f88"))
 112     (t (:foreground "#622")))
 113   "Face for traceback headers in the output of doctest examples."
 114   :group 'doctest)
 115 
 116 (defface doctest-results-divider-face
 117   '((((class color) (background dark))
 118      (:foreground "#08f"))
 119     (t (:foreground "#00f")))
 120   "Face for dividers in the doctest results window."
 121   :group 'doctest)
 122 
 123 (defface doctest-results-loc-face
 124   '((((class color) (background dark))
 125      (:foreground "#0f8"))
 126     (t (:foreground "#084")))
 127   "Face for location headers in the doctest results window."
 128   :group 'doctest)
 129 
 130 (defface doctest-results-header-face
 131   '((((class color) (background dark))
 132      (:foreground "#8ff"))
 133     (t (:foreground "#088")))
 134   "Face for sub-headers in the doctest results window."
 135   :group 'doctest)
 136 
 137 (defface doctest-results-selection-face
 138   '((((class color) (background dark))
 139      (:foreground "#ff0" :background "#008"))
 140     (t (:background "#088" :foreground "#fff")))
 141   "Face for selected failure's location header in the results window."
 142   :group 'doctest)
 143 
 144 (defface doctest-selection-face
 145   '((((class color) (background dark))
 146      (:foreground "#ff0" :background "#00f" :bold t))
 147     (t (:foreground "#f00")))
 148   "Face for selected example's prompt"
 149   :group 'doctest)
 150 
 151 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 152 ;; Constants
 153 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 154 
 155 (defconst doctest-prompt-re
 156   "^\\([ \t]*\\)\\(>>> ?\\|[.][.][.] ?\\)\\([ \t]*\\)"
 157   "Regular expression for doctest prompts.  It defines three groups:
 158 the pre-prompt margin; the prompt; and the post-prompt indentation.")
 159 
 160 (defconst doctest-open-block-re
 161   "[^\n]+:[ \t]*\\(#.*\\)?$"
 162   "Regular expression for a line that opens a block")
 163 
 164 (defconst doctest-close-block-re
 165   "\\(return\\|raise\\|break\\|continue\\|pass\\)\\b"
 166   "Regular expression for a line that closes a block")
 167 
 168 (defconst doctest-outdent-re
 169   (concat "\\(" (mapconcat 'identity
 170 			   '("else:"
 171 			     "except\\(\\s +.*\\)?:"
 172 			     "finally:"
 173 			     "elif\\s +.*:")
 174 			   "\\|")
 175 	  "\\)")
 176   "Regular expression for a line that should be outdented.  Any line
 177 that matches `doctest-outdent-re', but does not follow a line matching
 178 `doctest-no-outdent-re', will be outdented.")
 179 
 180 (defconst doctest-no-outdent-re
 181   (concat
 182    "\\("
 183    (mapconcat 'identity
 184 	      (list "try:"
 185 		    "except\\(\\s +.*\\)?:"
 186 		    "while\\s +.*:"
 187 		    "for\\s +.*:"
 188 		    "if\\s +.*:"
 189 		    "elif\\s +.*:"
 190                     "\\(return\\|raise\\|break\\|continue\\|pass\\)[ \t\n]"
 191 		    )
 192 	      "\\|")
 193 	  "\\)")
 194   "Regular expression matching lines not to outdent after.  Any line
 195 that matches `doctest-outdent-re', but does not follow a line matching
 196 `doctest-no-outdent-re', will be outdented.")
 197 
 198 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 199 ;; Colorization support (font-lock mode)
 200 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 201 
 202 ;; Define the font-lock keyword table.
 203 (defconst doctest-font-lock-keywords
 204   (let ((prompt "^[ \t]*\\(>>>\\|\\.\\.\\.\\)")
 205         (kw1 (mapconcat 'identity
 206 			'("and"      "assert"   "break"   "class"
 207 			  "continue" "def"      "del"     "elif"
 208 			  "else"     "except"   "exec"    "for"
 209 			  "from"     "global"   "if"      "import"
 210 			  "in"       "is"       "lambda"  "not"
 211 			  "or"       "pass"     "print"   "raise"
 212 			  "return"   "while"    "yield"
 213 			  )
 214 			"\\|"))
 215 	(kw2 (mapconcat 'identity
 216 			'("else:" "except:" "finally:" "try:")
 217 			"\\|"))
 218 	(kw3 (mapconcat 'identity
 219 			'("ArithmeticError" "AssertionError"
 220 			  "AttributeError" "DeprecationWarning" "EOFError"
 221 			  "Ellipsis" "EnvironmentError" "Exception" "False"
 222 			  "FloatingPointError" "FutureWarning" "IOError"
 223 			  "ImportError" "IndentationError" "IndexError"
 224 			  "KeyError" "KeyboardInterrupt" "LookupError"
 225 			  "MemoryError" "NameError" "None" "NotImplemented"
 226 			  "NotImplementedError" "OSError" "OverflowError"
 227 			  "OverflowWarning" "PendingDeprecationWarning"
 228 			  "ReferenceError" "RuntimeError" "RuntimeWarning"
 229 			  "StandardError" "StopIteration" "SyntaxError"
 230 			  "SyntaxWarning" "SystemError" "SystemExit"
 231 			  "TabError" "True" "TypeError" "UnboundLocalError"
 232 			  "UnicodeDecodeError" "UnicodeEncodeError"
 233 			  "UnicodeError" "UnicodeTranslateError"
 234 			  "UserWarning" "ValueError" "Warning"
 235 			  "ZeroDivisionError" "__debug__"
 236 			  "__import__" "__name__" "abs" "apply" "basestring"
 237 			  "bool" "buffer" "callable" "chr" "classmethod"
 238 			  "cmp" "coerce" "compile" "complex" "copyright"
 239 			  "delattr" "dict" "dir" "divmod"
 240 			  "enumerate" "eval" "execfile" "exit" "file"
 241 			  "filter" "float" "getattr" "globals" "hasattr"
 242 			  "hash" "hex" "id" "input" "int" "intern"
 243 			  "isinstance" "issubclass" "iter" "len" "license"
 244 			  "list" "locals" "long" "map" "max" "min" "object"
 245 			  "oct" "open" "ord" "pow" "property" "range"
 246 			  "raw_input" "reduce" "reload" "repr" "round"
 247 			  "setattr" "slice" "staticmethod" "str" "sum"
 248 			  "super" "tuple" "type" "unichr" "unicode" "vars"
 249 			  "xrange" "zip")
 250 			"\\|"))
 251         (pseudokw (mapconcat 'identity
 252                         '("self" "None" "True" "False" "Ellipsis")
 253                         "\\|"))
 254         (brk "\\([ \t(]\\|$\\)")
 255 	)
 256     `(
 257       ;; The following pattern colorizes source lines.  In particular,
 258       ;; it first matches prompts, and then looks for any of the
 259       ;; following matches *on the same line* as the prompt.  It uses
 260       ;; the form:
 261       ;;
 262       ;;   (MATCHER MATCH-HIGHLIGHT
 263       ;;            (ANCHOR-MATCHER nil nil MATCH-HIGHLIGHT)
 264       ;;            ...
 265       ;;            (ANCHOR-MATCHER nil nil MATCH-HIGHLIGHT))
 266       ;;
 267       ;; See the variable documentation for font-lock-keywords for a
 268       ;; description of what each of those means.
 269       (,prompt (1 'doctest-prompt-face)
 270                ;; classes
 271                ("\\b\\(class\\)[ \t]+\\([a-zA-Z_]+[a-zA-Z0-9_]*\\)"
 272                 nil nil (1 'font-lock-keyword-face)
 273                 (2 'font-lock-type-face))
 274                ;; functions
 275                ("\\b\\(def\\)[ \t]+\\([a-zA-Z_]+[a-zA-Z0-9_]*\\)"
 276                 nil nil (1 'font-lock-keyword-face) (2 'font-lock-type-face))
 277                ;; keywords
 278                (,(concat "\\b\\(" kw1 "\\)" brk)
 279                 nil nil (1 'font-lock-keyword-face))
 280                ;; builtins when they don't appear as object attributes
 281                (,(concat "\\(\\b\\|[.]\\)\\(" kw3 "\\)" brk)
 282                 nil nil (2 'font-lock-keyword-face))
 283                ;; block introducing keywords with immediately
 284                ;; following colons.  Yes "except" is in both lists.
 285                (,(concat "\\b\\(" kw2 "\\)" brk)
 286                 nil nil (1 'font-lock-keyword-face))
 287                ;; `as' but only in "import foo as bar"
 288                ("[ \t]*\\(\\bfrom\\b.*\\)?\\bimport\\b.*\\b\\(as\\)\\b"
 289                 nil nil (2 'font-lock-keyword-face))
 290                ;; pseudo-keywords
 291                (,(concat "\\b\\(" pseudokw "\\)" brk)
 292                 nil nil (1 'font-lock-keyword-face))
 293                ;; comments
 294                ("\\(#.*\\)"
 295                 nil nil (1 'font-lock-comment-face)))
 296 
 297       ;; The following pattern colorizes output lines.  In particular,
 298       ;; it uses doctest-output-line-matcher to check if this is an
 299       ;; output line, and if so, it colorizes it, and any special
 300       ;; markers it contains.
 301       (doctest-output-line-matcher
 302        (0 'doctest-output-face t)
 303        ("\\.\\.\\." (beginning-of-line) (end-of-line)
 304 	(0 'doctest-output-marker-face t))
 305        ("<BLANKLINE>" (beginning-of-line) (end-of-line)
 306 	(0 'doctest-output-marker-face t))
 307        ("^Traceback (most recent call last):" (beginning-of-line) (end-of-line)
 308 	(0 'doctest-output-traceback-face t))
 309        ("^Traceback (innermost last):" (beginning-of-line) (end-of-line)
 310 	(0 'doctest-output-traceback-face t))
 311        )
 312 
 313       ;; A PS1 prompt followed by a non-space is an error.
 314       ("^[ \t]*\\(>>>[^ \t\n][^\n]*\\)" (1 'font-lock-warning-face t))
 315 
 316       ;; Selected example (to highlight selected failure)
 317       (doctest-selection-matcher (0 'doctest-selection-face t))
 318       ))
 319   "Expressions to highlight in Doctest mode.")
 320 
 321 (defun doctest-output-line-matcher (limit)
 322   "A `font-lock-keyword' MATCHER that returns t if the current 
 323 line is the expected output for a doctest example, and if so, 
 324 sets `match-data' so that group 0 spans the current line."
 325   ;; The real work is done by find-doctest-output-line.
 326   (when (find-doctest-output-line limit)
 327     ;; If we found one, then mark the entire line.
 328     (beginning-of-line)
 329     (search-forward-regexp "[^\n]*" limit)))
 330 
 331 ;; [XX] Under construction.
 332 (defun doctest-selection-matcher (limit)
 333   (let (found-it)
 334     (while (and (not found-it) 
 335                 (search-forward-regexp "^[ \t]*\\(>>>\\|[.][.][.]\\)"
 336                                        limit t))
 337       (if (get-text-property (point) 'doctest-selected)
 338           (setq found-it t)))
 339     found-it))
 340 
 341 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 342 ;; Source line indentation
 343 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 344 
 345 (defun doctest-indent-source-line (&optional dedent-only)
 346   "Re-indent the current line, as doctest source code.  I.e., add a
 347 prompt to the current line if it doesn't have one, and re-indent the
 348 source code (to the right of the prompt).  If `dedent-only' is true,
 349 then don't increase the indentation level any."
 350   (interactive "*")
 351   (let ((indent-end nil))
 352     (save-excursion
 353       (beginning-of-line)
 354       (let ((new-indent (doctest-current-source-line-indentation dedent-only))
 355             (new-margin (doctest-current-source-line-margin))
 356             (line-had-prompt (looking-at doctest-prompt-re)))
 357         ;; Delete the old prompt (if any).
 358         (when line-had-prompt
 359           (goto-char (match-end 1))
 360           (delete-char 4))
 361         ;; Delete the old indentation.
 362         (delete-backward-char (skip-chars-forward " \t"))
 363         ;; If it's a continuation line, or a new PS1 prompt,
 364         ;; then copy the margin.
 365         (when (or new-indent (not line-had-prompt))
 366           (beginning-of-line)
 367           (delete-backward-char (skip-chars-forward " \t"))
 368           (insert-char ?\  new-margin))
 369         ;; Add the new prompt.
 370         (insert-string (if new-indent "... " ">>> "))
 371         ;; Add the new indentation
 372         (if new-indent (insert-char ?\  new-indent))
 373         (setq indent-end (point))))
 374     ;; If we're left of the indentation end, then move up to the
 375     ;; indentation end.
 376     (if (< (point) indent-end) (goto-char indent-end))))
 377 
 378 (defun doctest-current-source-line-indentation (&optional dedent-only)
 379   "Return the post-prompt indent to use for this line.  This is an
 380 integer for a continuation lines, and nil for non-continuation lines."
 381   (save-excursion
 382     (let ((prev-line-indent 0)
 383           (curr-line-indent 0)
 384           (prev-line-opens-block nil)
 385           (prev-line-closes-block nil)
 386           (curr-line-outdented nil))
 387       ;; Examine this doctest line.
 388       (beginning-of-line)
 389       (when (looking-at doctest-prompt-re)
 390           (setq curr-line-indent (- (match-end 3) (match-beginning 3)))
 391 	  (goto-char (match-end 3)))
 392       (setq curr-line-outdented (looking-at doctest-outdent-re))
 393       ;; Examine the previous line.
 394       (when (= (forward-line -1) 0) ; move up a line
 395 	(when (looking-at doctest-prompt-re) ; is it a source line?
 396 	  (let ((indent-beg (column-at-char (match-beginning 3)))
 397 		(indent-end (column-at-char (match-end 3))))
 398 	    (setq prev-line-indent (- indent-end indent-beg))
 399 	    (goto-char (match-end 3))
 400 	    (if (looking-at doctest-open-block-re)
 401 		(setq prev-line-opens-block t))
 402 	    (if (looking-at doctest-close-block-re)
 403 		(setq prev-line-closes-block t))
 404 	    (if (looking-at doctest-no-outdent-re)
 405 		(setq curr-line-outdented nil))
 406 	    )))
 407       (let ((indent (+ prev-line-indent
 408                        (if curr-line-outdented -4 0)
 409                        (if prev-line-opens-block 4 0)
 410                        (if prev-line-closes-block -4 0))))
 411 	;; If dedent-only is true, then make sure we don't indent.
 412 	(when dedent-only 
 413 	  (setq indent (min indent curr-line-indent)))
 414 	;; If indent=0 and we're not outdented, then set indent to
 415 	;; nil (to signify the start of a new source example).
 416 	(when (and (= indent 0) (not curr-line-outdented))
 417 	  (setq indent nil))
 418 	;; Return the indentation.
 419 	indent))))
 420 
 421 (defun doctest-current-source-line-margin ()
 422   "Return the pre-prompt margin to use for this source line.  This is
 423 copied from the most recent source line, or set to
 424 `doctest-default-margin' if there are no preceeding source lines."
 425   (save-excursion
 426     (beginning-of-line)
 427     (if (search-backward-regexp doctest-prompt-re nil t)
 428         (let ((margin-beg (column-at-char (match-beginning 1)))
 429               (margin-end (column-at-char (match-end 1))))
 430           (- margin-end margin-beg))
 431       doctest-default-margin)))
 432 
 433 (defun doctest-electric-backspace ()
 434   "Delete the preceeding character, level of indentation, or
 435 prompt.  
 436 
 437 If point is at the leftmost column, delete the preceding newline.
 438 
 439 Otherwise, if point is at the first non-whitespace character
 440 following an indented source line's prompt, then reduce the
 441 indentation to the next multiple of 4; and update the source line's
 442 prompt, when necessary.
 443 
 444 Otherwise, if point is at the first non-whitespace character
 445 following an unindented source line's prompt, then remove the
 446 prompt (converting the line to an output line or text line).
 447 
 448 Otherwise, if point is at the first non-whitespace character of a
 449 line, the delete the line's indentation.
 450 
 451 Otherwise, delete the preceeding character.
 452 "
 453   (interactive "*")
 454   (cond 
 455    ;; Beginning of line: delete preceeding newline.
 456    ((bolp) (backward-delete-char 1))
 457       
 458    ;; First non-ws char following prompt: dedent or remove prompt.
 459    ((and (looking-at "[^ \t\n]\\|$") (doctest-looking-back doctest-prompt-re))
 460     (let* ((prompt-beg (match-beginning 2))
 461 	   (indent-beg (match-beginning 3)) (indent-end (match-end 3))
 462 	   (old-indent (- indent-end indent-beg))
 463 	   (new-indent (* (/ (- old-indent 1) 4) 4)))
 464       (cond
 465        ;; Indented source line: dedent it.
 466        ((> old-indent 0)
 467 	(goto-char indent-beg)
 468 	(delete-region indent-beg indent-end)
 469 	(insert-char ?\  new-indent)
 470 	;; Change prompt to PS1, when appropriate.
 471 	(when (and (= new-indent 0) (not (looking-at doctest-outdent-re)))
 472 	  (delete-backward-char 4)
 473 	  (insert-string ">>> ")))
 474        ;; Non-indented source line: remove prompt.
 475        (t
 476 	(goto-char indent-end)
 477 	(delete-region prompt-beg indent-end)))))
 478 
 479    ;; First non-ws char of a line: delete all indentation.
 480    ((and (looking-at "[^ \n\t]\\|$") (doctest-looking-back "^[ \t]+"))
 481     (delete-region (match-beginning 0) (match-end 0)))
 482 
 483    ;; Otherwise: delete a character.
 484    (t
 485     (backward-delete-char 1))))
 486 
 487 (defun doctest-newline-and-indent ()
 488   "Insert a newline, and indent the new line appropriately.
 489 
 490 If the current line is a source line containing a bare prompt,
 491 then clear the current line, and insert a newline.
 492 
 493 Otherwise, if the current line is a source line, then insert a
 494 newline, and add an appropriately indented prompt to the new
 495 line.
 496 
 497 Otherwise, if the current line is an output line, then insert a
 498 newline and indent the new line to match the example's margin.
 499 
 500 Otherwise, insert a newline.
 501 
 502 If `doctest-avoid-trailing-whitespace' is true, then clear any
 503 whitespace to the left of the point before inserting a newline.
 504 "
 505   (interactive "*")
 506   ;; If we're avoiding trailing spaces, then delete WS before point.
 507   (if doctest-avoid-trailing-whitespace
 508       (delete-char (- (skip-chars-backward " \t"))))     
 509   (cond 
 510    ;; If we're on an empty prompt, delete it.
 511    ((on-empty-doctest-source-line)
 512     (delete-region (match-beginning 0) (match-end 0))
 513     (insert-char ?\n 1))
 514    ;; If we're on a doctest line, add a new prompt.
 515    ((on-doctest-source-line)
 516     (insert-char ?\n 1)
 517     (doctest-indent-source-line))
 518    ;; If we're in doctest output, indent to the margin.
 519    ((on-doctest-output-line)
 520     (insert-char ?\n 1)
 521     (insert-char ?\  (doctest-current-source-line-margin)))
 522    ;; Otherwise, just add a newline.
 523    (t (insert-char ?\n 1))))
 524 
 525 (defun doctest-electric-colon ()
 526   "Insert a colon, and dedent the line when appropriate."
 527   (interactive "*")
 528   (insert-char ?: 1)
 529   (when (on-doctest-source-line)
 530     (doctest-indent-source-line t)))
 531 
 532 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 533 ;; Code Execution
 534 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 535 
 536 ;; Add support for options (eg diff!)
 537 (defun doctest-execute-buffer ()
 538   "Run doctest on the current buffer, and display the results in the 
 539 *doctest-output* buffer."
 540   (interactive "*")
 541   (setq doctest-results-buffer (get-buffer-create "*doctest-output*"))
 542   (let* ((temp (concat (doctest-temp-name) ".py"))
 543 	 (tempfile (expand-file-name temp doctest-temp-directory))
 544 	 (cur-buf (current-buffer))
 545 	 (in-buf (get-buffer-create "*doctest-input*"))
 546 	 (beg (point-min)) (end (point-max))
 547 	 (script (concat "from doctest import *\n"
 548 			 "doc = open('" tempfile "').read()\n"
 549 			 "test = DocTestParser().get_doctest("
 550 			         "doc, {}, '" (buffer-name) "', '"
 551 				 (buffer-file-name) "', 0)\n"
 552 			 "r = DocTestRunner()\n"
 553 			 "r.run(test)\n"))
 554 	 (cmd (concat doctest-python-command " -c \"" script "\"")))
 555     ;; Write buffer to a file.
 556     (save-excursion
 557       (set-buffer in-buf)
 558       (insert-buffer-substring cur-buf beg end)
 559       (write-file tempfile))
 560     ;; Run doctest
 561     (shell-command cmd doctest-results-buffer)
 562     ;; Delete the temp file
 563     (delete-file tempfile)
 564     ;; Set mode on output buffer.
 565     (save-excursion
 566       (set-buffer doctest-results-buffer)
 567       (doctest-results-mode))
 568     ;; If any tests failed, display them.
 569     (cond ((> (buffer-size doctest-results-buffer) 0)
 570 	   (message "Test failed!")
 571 	   (display-buffer doctest-results-buffer)
 572 	   (doctest-postprocess-results))
 573 	  (t
 574 	   (message "Test passed!")
 575 	   (if (get-buffer-window doctest-results-buffer)
 576 	       (delete-window (get-buffer-window doctest-results-buffer)))))))
 577 
 578 (defun doctest-postprocess-results ()
 579   (doctest-next-failure 1)
 580   (if hide-example-source
 581     (hide-example-source)))
 582 
 583 (defun doctest-next-failure (count)
 584   "Move to the top of the next failing example, and highlight the
 585 example's failure description in *doctest-output*."
 586   (interactive "p")
 587   (let (lineno)
 588     (cond
 589      ((not (buffer-live-p doctest-results-buffer))
 590       (message "Run doctest first! (C-c C-c)"))
 591      (t
 592       (save-excursion
 593         (let ((orig-window (selected-window))
 594               (results-window (display-buffer doctest-results-buffer)))
 595           ;; Switch to the results window (so its point gets updated)
 596           (if results-window (select-window results-window))
 597           ;; Pick up where we left off.
 598           ;; (nb: doctest-selected-failure is buffer-local)
 599           (goto-char (or doctest-selected-failure (point-min)))
 600           ;; Skip past anything on *this* line.
 601           (if (>= count 0) (end-of-line) (beginning-of-line))
 602           ;; Look for the next failure
 603           (if (>= count 0)
 604               (re-search-forward doctest-results-loc-re nil t count)
 605             (re-search-backward doctest-results-loc-re nil t (- count)))
 606           (cond
 607            ;; We found a failure:
 608            ((match-string 2)
 609             (let ((old-selected-failure doctest-selected-failure))
 610               ;; Extract the line number for the doctest file.
 611               (setq lineno (string-to-int (match-string 2)))
 612               ;; Store our position for next time.
 613               (beginning-of-line)
 614               (setq doctest-selected-failure (point))
 615               ;; Update selection.
 616               (doctest-fontify-line old-selected-failure)
 617               (doctest-fontify-line doctest-selected-failure)))
 618            ;; We didn't find a failure:
 619            (t
 620             (message "No failures found!")))
 621           ;; Return to the original window
 622           (select-window orig-window)))))
 623 
 624     (when lineno
 625       ;; Move point to the selected failure.
 626       (goto-line lineno)
 627 ;      ;; Highlight it. [XX] Under construction.
 628 ;      (let ((beg (save-excursion (beginning-of-line) (point)))
 629 ;            (end (save-excursion (end-of-line) (point))))
 630 ;        (add-text-properties (point-min) (point-max) '(doctest-selected nil))
 631 ;        (add-text-properties beg end '(doctest-selected t))
 632 ;        (doctest-fontify-line (point)))
 633       )))
 634 
 635 (defun doctest-prev-failure (count)
 636   "Move to the top of the previous failing example, and highlight
 637 the example's failure description in *doctest-output*."
 638   (interactive "p")
 639   (doctest-next-failure (- count)))
 640 
 641 (defun doctest-first-failure ()
 642   (interactive "")
 643   (if (buffer-live-p doctest-results-buffer)
 644       (save-excursion
 645         (set-buffer doctest-results-buffer)
 646         (let ((old-selected-failure doctest-selected-failure))
 647           (setq doctest-selected-failure (point-min))
 648           (doctest-fontify-line old-selected-failure))))
 649   (doctest-next-failure 1))
 650 
 651 (defun doctest-last-failure ()
 652   (interactive "")
 653   (if (buffer-live-p doctest-results-buffer)
 654       (save-excursion
 655         (set-buffer doctest-results-buffer)
 656         (let ((old-selected-failure doctest-selected-failure))
 657           (setq doctest-selected-failure (point-max))
 658           (doctest-fontify-line old-selected-failure))))
 659   (doctest-next-failure -1))
 660 
 661 (defconst doctest-example-source-re 
 662   "^Failed example:\n\\(\n\\|    [^\n]*\n\\)+")
 663 (defun hide-example-source ()
 664   "Delete the source code listings from the results buffer (since it's
 665 easy enough to see them in the original buffer)"
 666   (save-excursion
 667     (set-buffer doctest-results-buffer)
 668     (toggle-read-only nil)
 669     (beginning-of-buffer)
 670     (while (re-search-forward doctest-example-source-re nil t)
 671       (replace-match "" nil nil))
 672     (toggle-read-only t)))
 673 
 674 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 675 ;; Doctest Results Mode (output of doctest-execute-buffer)
 676 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 677 ;; [XX] Todo:
 678 ;;   - Make it read-only?
 679 ;;   - Hitting enter goes to the corresponding error
 680 ;;   - Clicking goes to corresponding error (not as useful)
 681 
 682 
 683 (defconst doctest-results-divider-re
 684   "^\\([*]\\{60,\\}\\)$")
 685 
 686 (defconst doctest-results-loc-re
 687   "^File \"\\([^\"]+\\)\", line \\([0-9]+\\), in \\([^\n]+\\)")
 688 
 689 (defconst doctest-results-header-re
 690   "^\\([a-zA-Z0-9 ]+:\\)$")
 691 
 692 (defconst doctest-results-font-lock-keywords
 693   `((,doctest-results-divider-re 
 694      (0 'doctest-results-divider-face))
 695     (,doctest-results-loc-re 
 696      (0 'doctest-results-loc-face))
 697     (,doctest-results-header-re 
 698      (0 'doctest-results-header-face))
 699     (doctest-results-selection-matcher 
 700      (0 'doctest-results-selection-face t))))
 701 
 702 (defun doctest-results-selection-matcher (limit)
 703   "Matches from `doctest-selected-failure' to the end of the
 704 line.  This is used to highlight the currently selected failure."
 705   (when (and doctest-selected-failure
 706 	     (<= (point) doctest-selected-failure)
 707 	     (< doctest-selected-failure limit))
 708     (goto-char doctest-selected-failure)
 709     (search-forward-regexp "[^\n]+" limit)))
 710 
 711 ;; Register the font-lock keywords (xemacs)
 712 (put 'doctest-results-mode 'font-lock-defaults 
 713      '(doctest-results-font-lock-keywords))
 714 
 715 ;; Register the font-lock keywords (gnu emacs)
 716 (defvar font-lock-defaults-alist nil) ; in case we're in xemacs
 717 (setq font-lock-defaults-alist
 718       (append font-lock-defaults-alist
 719               `((doctest-results-mode 
 720 		 doctest-results-font-lock-keywords 
 721 		 nil nil nil nil))))
 722 
 723 ;; Define the mode
 724 (define-derived-mode doctest-results-mode text-mode "Doctest Results"
 725   "docstring"
 726   ;; Enable font-lock mode.
 727   (if (featurep 'font-lock) (font-lock-mode 1))
 728   ;; Keep track of which failure is selected
 729   (set (make-local-variable 'doctest-selected-failure) nil)
 730   ;; Make the buffer read-only.
 731   (toggle-read-only t))
 732 
 733 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 734 ;; Helper functions
 735 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 736 
 737 (defun on-doctest-source-line ()
 738   "Return true if the current line is a source line."
 739   (save-excursion
 740     (beginning-of-line)
 741     (looking-at doctest-prompt-re)))
 742 
 743 (defun on-empty-doctest-source-line ()
 744   "Return true if the current line contains a bare prompt."
 745   (save-excursion
 746     (beginning-of-line)
 747     (looking-at (concat doctest-prompt-re "$"))))
 748 
 749 (defun on-doctest-output-line ()
 750   "Return true if the current line is an output line."
 751   (save-excursion
 752     (beginning-of-line)
 753     (let ((prompt-or-blankline (concat doctest-prompt-re "\\|" "^[ \t]*\n")))
 754       ;; The line must not be blank or start with a prompt.
 755       (when (not (looking-at prompt-or-blankline))
 756           ;; The line must follow a line starting with a prompt, with
 757           ;; no intervening blank lines.
 758           (search-backward-regexp prompt-or-blankline nil t)
 759           (looking-at doctest-prompt-re)))))
 760 
 761 (defun find-doctest-output-line (&optional limit)
 762   "Move forward to the next doctest output line (staying within
 763 the given bounds).  Return the character position of the doctest
 764 output line if one was found, and false otherwise."
 765   (let ((found-it nil) ; point where we found an output line
 766 	(limit (or limit (point-max)))) ; default value for limit
 767     (save-excursion
 768       ;; Keep moving forward, one line at a time, until we find a
 769       ;; doctest output line.
 770       (while (and (not found-it) (< (point) limit) (not (eobp)))
 771 	(if (and (not (eolp)) (on-doctest-output-line))
 772 	    (setq found-it (point))
 773 	  (forward-line))))
 774     ;; If we found a doctest output line, then go to it.
 775     (if found-it (goto-char found-it))))
 776 
 777 (defun doctest-version ()
 778   "Echo the current version of `doctest-mode' in the minibuffer."
 779   (interactive)
 780   (message "Using `doctest-mode' version %s" doctest-version))
 781 
 782 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 783 ;; Utility functions
 784 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 785 
 786 (defvar doctest-serial-number 0) ;used if broken-temp-names.
 787 (defun doctest-temp-name ()
 788   (if (memq 'broken-temp-names features)
 789       (let
 790 	  ((sn doctest-serial-number)
 791 	   (pid (and (fboundp 'emacs-pid) (emacs-pid))))
 792 	(setq doctest-serial-number (1+ doctest-serial-number))
 793 	(if pid
 794 	    (format "doctest-%d-%d" sn pid)
 795 	  (format "doctest-%d" sn)))
 796     (make-temp-name "doctest-")))
 797 
 798 (defun column-at-char (pos)
 799   "Return the column of the given character position"
 800   (save-excursion (goto-char pos) (current-column)))
 801 
 802 (defun doctest-looking-back (regexp)
 803   "Return True if the text before point matches the given regular
 804 expression.  Like looking-at except backwards and slower.  (This
 805 is available as `looking-back' in GNU emacs and
 806 `looking-at-backwards' in XEmacs, but it's easy enough to define
 807 from scratch such that it works under both.)"
 808   (save-excursion
 809     (let ((orig-pos (point)))
 810       ;; Search backwards for the regexp.
 811       (if (re-search-backward regexp nil t)
 812 	  ;; Check if it ends at the original point.
 813 	  (= orig-pos (match-end 0))))))
 814 
 815 (defun doctest-fontify-line (charpos)
 816   "Run font-lock-fontify-region on the line containing the given
 817 position."
 818   (if charpos
 819       (save-excursion
 820         (goto-char charpos)
 821         (let ((beg (progn (beginning-of-line) (point)))
 822               (end (progn (end-of-line) (point))))
 823           (font-lock-fontify-region beg end)))))
 824   
 825 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 826 ;; Syntax Table
 827 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 828 
 829 ;; We do *NOT* currently use this, because it applies too
 830 ;; indiscrimanantly.  In particular, we don't want "'" and '"' treated
 831 ;; as quote marks on text lines.  But there's no good way to prevent
 832 ;; it.
 833 (defvar doctest-syntax-alist nil
 834   "Syntax alist used in `doctest-mode' buffers.")
 835 (setq doctest-syntax-alist '((?\( . "()") (?\[ . "(]") (?\{ . "(}")
 836 			     (?\) . ")(") (?\] . ")[") (?\} . "){")
 837 			     (?\$ . "." ) (?\% . "." ) (?\& . "." )
 838 			     (?\* . "." ) (?\+ . "." ) (?\- . "." )
 839 			     (?\/ . "." ) (?\< . "." ) (?\= . "." )
 840 			     (?\> . "." ) (?\| . "." ) (?\_ . "w" )
 841 			     (?\' . "\"") (?\" . "\"") (?\` . "$" )
 842 			     (?\# . "<" ) (?\n . ">" )))
 843 
 844 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 845 ;; Key Bindings
 846 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 847 
 848 (defconst doctest-mode-map 
 849   (let ((map (make-keymap)))
 850     (define-key map [backspace] 'doctest-electric-backspace)
 851     (define-key map [return] 'doctest-newline-and-indent)
 852     (define-key map [tab] 'doctest-indent-source-line)
 853     (define-key map ":" 'doctest-electric-colon)
 854     (define-key map "\C-c\C-v" 'doctest-version)
 855     (define-key map "\C-c\C-c" 'doctest-execute-buffer)
 856     (define-key map "\C-c\C-n" 'doctest-next-failure)
 857     (define-key map "\C-c\C-p" 'doctest-prev-failure)
 858     (define-key map "\C-c\C-a" 'doctest-first-failure)
 859     (define-key map "\C-c\C-z" 'doctest-last-failure)
 860     map) 
 861   "Keymap for doctest-mode.")
 862 
 863 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 864 ;; Define the mode
 865 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 866 
 867 ;; Register the font-lock keywords (xemacs)
 868 (put 'doctest-mode 'font-lock-defaults '(doctest-font-lock-keywords))
 869 
 870 ;; Register the font-lock keywords (gnu emacs)
 871 (defvar font-lock-defaults-alist nil) ; in case we're in xemacs
 872 (setq font-lock-defaults-alist
 873       (append font-lock-defaults-alist
 874               `((doctest-mode doctest-font-lock-keywords nil nil nil nil))))
 875 
 876 ;; Use doctest mode for files ending in .doctest
 877 ;;;###autoload
 878 (add-to-list 'auto-mode-alist '("\\.doctest$" . doctest-mode))
 879 
 880 ;;;###autoload
 881 (define-derived-mode doctest-mode text-mode "Doctest"
 882   "A major mode for editing text files that contain Python
 883 doctest examples.  Doctest is a testing framework for Python that
 884 emulates an interactive session, and checks the result of each
 885 command.  For more information, see the Python library reference:
 886 <http://docs.python.org/lib/module-doctest.html>
 887 
 888 `doctest-mode' defines three kinds of line, each of which is
 889 treated differently:
 890 
 891   - 'Source lines' are lines consisting of a Python prompt
 892     ('>>>' or '...'), followed by source code.  Source lines are
 893     colored (similarly to `python-mode') and auto-indented.
 894 
 895   - 'Output lines' are non-blank lines immediately following
 896     source lines.  They are colored using several doctest-
 897     specific output faces.
 898 
 899   - 'Text lines' are any other lines.  They are not processed in
 900     any special way.
 901 
 902 \\{doctest-mode-map}
 903 "
 904   ;; Enable auto-fill mode.
 905   (auto-fill-mode 1)
 906 
 907   ;; Enable font-lock mode.
 908   (if (featurep 'font-lock) (font-lock-mode 1))
 909   
 910   ;; Register our indentation function.
 911   (set (make-local-variable 'indent-line-function) 
 912        'doctest-indent-source-line)
 913 
 914   ;; Keep track of our results buffer.
 915   (set (make-local-variable 'doctest-results-buffer) nil)
 916   )
 917 
 918 (provide 'doctest-mode)
 919 ;;; doctest-mode.el ends here