misc/figleaf.el

   1
   2 ;(require 'gnus-start)
   3
   4 ; (defun gnus-load (file)
   5 ;   "Load FILE, but in such a way that read errors can be reported."
   6 ;   (with-temp-buffer
   7 ;     (insert-file-contents file)
   8 ;     (while (not (eobp))
   9 ;       (condition-case type
  10 ;         (let ((form (read (current-buffer))))
  11 ;           (eval form))
  12 ;       (error
  13 ;        (unless (eq (car type) 'end-of-file)
  14 ;          (let ((error (format "Error in %s line %d" file
  15 ;                               (count-lines (point-min) (point)))))
  16 ;            (ding)
  17 ;            (unless (gnus-yes-or-no-p (concat error "; continue? "))
  18 ;              (error "%s" error)))))))))
  19
  20 (defvar figleaf-annotation-file ".figleaf.el")
  21 (defvar figleaf-annotations nil)
  22
  23 (defun find-figleaf-annotation-file ()
  24   (let ((dir (file-name-directory buffer-file-name))
  25         (olddir "/"))
  26     (while (and (not (equal dir olddir))
  27                 (not (file-regular-p (concat dir figleaf-annotation-file))))
  28       (setq olddir dir
  29             dir (file-name-directory (directory-file-name dir))))
  30     (and (not (equal dir olddir)) (concat dir figleaf-annotation-file))
  31 ))
  32
  33 (defun load-figleaf-annotations ()
  34   (let* ((annotation-file (find-figleaf-annotation-file))
  35          (coverage
  36           (with-temp-buffer
  37             (insert-file-contents annotation-file)
  38             (let ((form (read (current-buffer))))
  39               (eval form)))))
  40     (setq figleaf-annotations coverage)
  41     coverage
  42     ))
  43
  44 (defun figleaf-unannotate ()
  45   (interactive)
  46   (save-excursion
  47     (dolist (ov (overlays-in (point-min) (point-max)))
  48       (delete-overlay ov))
  49     (setq figleaf-this-buffer-is-annotated nil)
  50     (message "Removed annotations")
  51 ))
  52
  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.
  59
  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).
  64
  65 (defun figleaf-annotate (&optional show-code)
  66   (interactive "P")
  67   (let ((allcoverage (load-figleaf-annotations))
  68         (filename-key buffer-file-name)
  69         thiscoverage code-lines covered-lines uncovered-code-lines
  70         )
  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))
  77     (if thiscoverage
  78         (progn
  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)
  83                 )
  84
  85           (save-excursion
  86             (dolist (ov (overlays-in (point-min) (point-max)))
  87               (delete-overlay ov))
  88             (if show-code
  89                 (dolist (line code-lines)
  90                   (goto-line line)
  91                   ;;(add-text-properties (point) (line-end-position) '(face bold) )
  92                   (overlay-put (make-overlay (point) (line-end-position))
  93                                         ;'before-string "C"
  94                                         ;'face '(background-color . "green")
  95                                'face '(:background "dark green")
  96                                )
  97                   ))
  98             (dolist (line uncovered-code-lines)
  99               (goto-line line)
 100               (overlay-put (make-overlay (point) (line-end-position))
 101                                         ;'before-string "D"
 102                                         ;'face '(:background "blue")
 103                                         ;'face '(:underline "blue")
 104                            'face '(:box "red")
 105                            )
 106               )
 107             (message "Added annotations")
 108             )
 109           )
 110       (message "unable to find coverage for this file"))
 111 ))
 112
 113 (defun figleaf-toggle-annotations (show-code)
 114   (interactive "P")
 115   (if figleaf-this-buffer-is-annotated
 116       (figleaf-unannotate)
 117     (figleaf-annotate show-code))
 118 )
 119
 120
 121 (setq figleaf-this-buffer-is-annotated nil)
 122 (make-variable-buffer-local 'figleaf-this-buffer-is-annotated)
 123
 124 (define-minor-mode figleaf-annotation-minor-mode
 125   "Minor mode to annotate code-coverage information"
 126   nil
 127   " FA"
 128   '(
 129     ("\C-c\C-a" . figleaf-toggle-annotations)
 130     )
 131
 132   () ; forms run on mode entry/exit
 133 )
 134
 135 (defun maybe-enable-figleaf-mode ()
 136   (if (string-match "/src/allmydata/" (buffer-file-name))
 137       (figleaf-annotation-minor-mode t)
 138     ))
 139
 140 (add-hook 'python-mode-hook 'maybe-enable-figleaf-mode)