4
; (defun gnus-load (file)
5
; "Load FILE, but in such a way that read errors can be reported."
7
; (insert-file-contents file)
10
; (let ((form (read (current-buffer))))
13
; (unless (eq (car type) 'end-of-file)
14
; (let ((error (format "Error in %s line %d" file
15
; (count-lines (point-min) (point)))))
17
; (unless (gnus-yes-or-no-p (concat error "; continue? "))
18
; (error "%s" error)))))))))
20
(defvar figleaf-annotation-file ".figleaf.el")
21
(defvar figleaf-annotations nil)
23
(defun find-figleaf-annotation-file ()
24
(let ((dir (file-name-directory buffer-file-name))
26
(while (and (not (equal dir olddir))
27
(not (file-regular-p (concat dir figleaf-annotation-file))))
29
dir (file-name-directory (directory-file-name dir))))
30
(and (not (equal dir olddir)) (concat dir figleaf-annotation-file))
33
(defun load-figleaf-annotations ()
34
(let* ((annotation-file (find-figleaf-annotation-file))
37
(insert-file-contents annotation-file)
38
(let ((form (read (current-buffer))))
40
(setq figleaf-annotations coverage)
44
(defun figleaf-unannotate ()
47
(dolist (ov (overlays-in (point-min) (point-max)))
49
(setq figleaf-this-buffer-is-annotated nil)
50
(message "Removed annotations")
53
;; in emacs22, it will be possible to put the annotations in the fringe. Set
54
;; a display property for one of the characters in the line, using
55
;; (right-fringe BITMAP FACE), where BITMAP should probably be right-triangle
56
;; or so, and FACE should probably be '(:foreground "red"). We can also
57
;; create new bitmaps, with faces. To do tartans will require a lot of
58
;; bitmaps, and you've only got about 8 pixels to work with.
60
;; unfortunately emacs21 gives us less control over the fringe. We can use
61
;; overlays to put letters on the left or right margins (in the text area,
62
;; overriding actual program text), and to modify the text being displayed
63
;; (by changing its background color, or adding a box around each word).
65
(defun figleaf-annotate (&optional show-code)
67
(let ((allcoverage (load-figleaf-annotations))
68
(filename-key buffer-file-name)
69
thiscoverage code-lines covered-lines uncovered-code-lines
71
(while (and (not (gethash filename-key allcoverage nil))
72
(string-match "/" filename-key))
73
;; eat everything up to and including the first slash, then look again
74
(setq filename-key (substring filename-key
75
(+ 1 (string-match "/" filename-key)))))
76
(setq thiscoverage (gethash filename-key allcoverage nil))
79
(setq figleaf-this-buffer-is-annotated t)
80
(setq code-lines (nth 0 thiscoverage)
81
covered-lines (nth 1 thiscoverage)
82
uncovered-code-lines (nth 2 thiscoverage)
86
(dolist (ov (overlays-in (point-min) (point-max)))
89
(dolist (line code-lines)
91
;;(add-text-properties (point) (line-end-position) '(face bold) )
92
(overlay-put (make-overlay (point) (line-end-position))
94
;'face '(background-color . "green")
95
'face '(:background "dark green")
98
(dolist (line uncovered-code-lines)
100
(overlay-put (make-overlay (point) (line-end-position))
102
;'face '(:background "blue")
103
;'face '(:underline "blue")
107
(message "Added annotations")
110
(message "unable to find coverage for this file"))
113
(defun figleaf-toggle-annotations (show-code)
115
(if figleaf-this-buffer-is-annotated
117
(figleaf-annotate show-code))
121
(setq figleaf-this-buffer-is-annotated nil)
122
(make-variable-buffer-local 'figleaf-this-buffer-is-annotated)
124
(define-minor-mode figleaf-annotation-minor-mode
125
"Minor mode to annotate code-coverage information"
129
("\C-c\C-a" . figleaf-toggle-annotations)
132
() ; forms run on mode entry/exit
135
(defun maybe-enable-figleaf-mode ()
136
(if (string-match "/src/allmydata/" (buffer-file-name))
137
(figleaf-annotation-minor-mode t)
140
(add-hook 'python-mode-hook 'maybe-enable-figleaf-mode)