2 (defvar coverage-annotation-file ".coverage.el")
3 (defvar coverage-annotations nil)
5 (defun find-coverage-annotation-file ()
6 (let ((dir (file-name-directory buffer-file-name))
8 (while (and (not (equal dir olddir))
9 (not (file-regular-p (concat dir coverage-annotation-file))))
11 dir (file-name-directory (directory-file-name dir))))
12 (and (not (equal dir olddir)) (concat dir coverage-annotation-file))
15 (defun load-coverage-annotations ()
16 (let* ((annotation-file (find-coverage-annotation-file))
19 (insert-file-contents annotation-file)
20 (let ((form (read (current-buffer))))
22 (setq coverage-annotations coverage)
26 (defun coverage-unannotate ()
28 (dolist (ov (overlays-in (point-min) (point-max)))
30 (setq coverage-this-buffer-is-annotated nil)
31 (message "Removed annotations")
34 ;; in emacs22, it will be possible to put the annotations in the fringe. Set
35 ;; a display property for one of the characters in the line, using
36 ;; (right-fringe BITMAP FACE), where BITMAP should probably be right-triangle
37 ;; or so, and FACE should probably be '(:foreground "red"). We can also
38 ;; create new bitmaps, with faces. To do tartans will require a lot of
39 ;; bitmaps, and you've only got about 8 pixels to work with.
41 ;; unfortunately emacs21 gives us less control over the fringe. We can use
42 ;; overlays to put letters on the left or right margins (in the text area,
43 ;; overriding actual program text), and to modify the text being displayed
44 ;; (by changing its background color, or adding a box around each word).
46 (defun coverage-annotate (show-code)
47 (let ((allcoverage (load-coverage-annotations))
48 (filename-key (expand-file-name buffer-file-truename))
49 thiscoverage code-lines covered-lines uncovered-code-lines
51 (while (and (not (gethash filename-key allcoverage nil))
52 (string-match "/" filename-key))
53 ;; eat everything up to and including the first slash, then look again
54 (setq filename-key (substring filename-key
55 (+ 1 (string-match "/" filename-key)))))
56 (setq thiscoverage (gethash filename-key allcoverage nil))
59 (setq coverage-this-buffer-is-annotated t)
60 (setq code-lines (nth 0 thiscoverage)
61 covered-lines (nth 1 thiscoverage)
62 uncovered-code-lines (nth 2 thiscoverage)
66 (dolist (ov (overlays-in (point-min) (point-max)))
69 (dolist (line code-lines)
71 ;;(add-text-properties (point) (line-end-position) '(face bold) )
72 (overlay-put (make-overlay (point) (line-end-position))
74 ;'face '(background-color . "green")
75 'face '(:background "dark green")
78 (dolist (line uncovered-code-lines)
80 (overlay-put (make-overlay (point) (line-end-position))
82 ;'face '(:background "blue")
83 ;'face '(:underline "blue")
87 (message "Added annotations")
90 (message "unable to find coverage for this file"))
93 (defun coverage-toggle-annotations (show-code)
95 (if coverage-this-buffer-is-annotated
97 (coverage-annotate show-code))
101 (setq coverage-this-buffer-is-annotated nil)
102 (make-variable-buffer-local 'coverage-this-buffer-is-annotated)
104 (define-minor-mode coverage-annotation-minor-mode
105 "Minor mode to annotate code-coverage information"
109 ("\C-c\C-a" . coverage-toggle-annotations)
112 () ; forms run on mode entry/exit
115 (defun maybe-enable-coverage-mode ()
116 (if (string-match "/src/allmydata/" (buffer-file-name))
117 (coverage-annotation-minor-mode t)
120 (add-hook 'python-mode-hook 'maybe-enable-coverage-mode)