~ubuntu-branches/ubuntu/karmic/tahoe-lafs/karmic

« back to all changes in this revision

Viewing changes to misc/figleaf.el

  • Committer: Bazaar Package Importer
  • Author(s): Zooko O'Whielacronx (Hacker)
  • Date: 2009-09-24 00:00:05 UTC
  • Revision ID: james.westby@ubuntu.com-20090924000005-ixe2n4yngmk49ysz
Tags: upstream-1.5.0
ImportĀ upstreamĀ versionĀ 1.5.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
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)