misc/coding_tools/coverage.el

   1
   2 (defvar coverage-annotation-file ".coverage.el")
   3 (defvar coverage-annotations nil)
   4
   5 (defun find-coverage-annotation-file ()
   6   (let ((dir (file-name-directory buffer-file-name))
   7         (olddir "/"))
   8     (while (and (not (equal dir olddir))
   9                 (not (file-regular-p (concat dir coverage-annotation-file))))
  10       (setq olddir dir
  11             dir (file-name-directory (directory-file-name dir))))
  12     (and (not (equal dir olddir)) (concat dir coverage-annotation-file))
  13 ))
  14
  15 (defun load-coverage-annotations ()
  16   (let* ((annotation-file (find-coverage-annotation-file))
  17          (coverage
  18           (with-temp-buffer
  19             (insert-file-contents annotation-file)
  20             (let ((form (read (current-buffer))))
  21               (eval form)))))
  22     (setq coverage-annotations coverage)
  23     coverage
  24     ))
  25
  26 (defun coverage-unannotate ()
  27   (save-excursion
  28     (dolist (ov (overlays-in (point-min) (point-max)))
  29       (delete-overlay ov))
  30     (setq coverage-this-buffer-is-annotated nil)
  31     (message "Removed annotations")
  32 ))
  33
  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.
  40
  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).
  45
  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
  50         )
  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))
  57     (if thiscoverage
  58         (progn
  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)
  63                 )
  64
  65           (save-excursion
  66             (dolist (ov (overlays-in (point-min) (point-max)))
  67               (delete-overlay ov))
  68             (if show-code
  69                 (dolist (line code-lines)
  70                   (goto-line line)
  71                   ;;(add-text-properties (point) (line-end-position) '(face bold) )
  72                   (overlay-put (make-overlay (point) (line-end-position))
  73                                         ;'before-string "C"
  74                                         ;'face '(background-color . "green")
  75                                'face '(:background "dark green")
  76                                )
  77                   ))
  78             (dolist (line uncovered-code-lines)
  79               (goto-line line)
  80               (overlay-put (make-overlay (point) (line-end-position))
  81                                         ;'before-string "D"
  82                                         ;'face '(:background "blue")
  83                                         ;'face '(:underline "blue")
  84                            'face '(:box "red")
  85                            )
  86               )
  87             (message "Added annotations")
  88             )
  89           )
  90       (message "unable to find coverage for this file"))
  91 ))
  92
  93 (defun coverage-toggle-annotations (show-code)
  94   (interactive "P")
  95   (if coverage-this-buffer-is-annotated
  96       (coverage-unannotate)
  97     (coverage-annotate show-code))
  98 )
  99
 100
 101 (setq coverage-this-buffer-is-annotated nil)
 102 (make-variable-buffer-local 'coverage-this-buffer-is-annotated)
 103
 104 (define-minor-mode coverage-annotation-minor-mode
 105   "Minor mode to annotate code-coverage information"
 106   nil
 107   " CA"
 108   '(
 109     ("\C-c\C-a" . coverage-toggle-annotations)
 110     )
 111
 112   () ; forms run on mode entry/exit
 113 )
 114
 115 (defun maybe-enable-coverage-mode ()
 116   (if (string-match "/src/allmydata/" (buffer-file-name))
 117       (coverage-annotation-minor-mode t)
 118     ))
 119
 120 (add-hook 'python-mode-hook 'maybe-enable-coverage-mode)