Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 59 lines (53 sloc) 3.078 kb
0860aa4 Jonathan Rockway add colorful-points
authored
1 (defvar colorful-points nil
2 "Alist mapping window -> overlay to color its point.")
3 (make-variable-buffer-local 'colorful-points)
4
5 (defvar colorful-points-colors '("blue" "purple" "green" "orange" "yellow" "red")
6 "Colors that the points can be. Chosen in order.")
7
9d0b9a5 Jonathan Rockway remove, don't delete.
authored
8 (define-minor-mode colorful-points-mode "Give each point in buffer a unique color." nil
9 " Colorful" nil
0860aa4 Jonathan Rockway add colorful-points
authored
10 (if colorful-points-mode
11 (progn ;; turning on
12 (make-variable-buffer-local 'after-change-functions)
13 (setq after-change-functions (cons #'colorful-points-after-change after-change-functions))
14 (colorful-points-after-change))
15 (progn ;; turning off
16 (mapc #'delete-overlay (mapcar #'cdr colorful-points))
17 (setq after-change-functions
18 (delete #'colorful-points-after-change after-change-functions)))))
19
20 (defun colorful-points--next-color ()
21 "Return a color for the next point. If you've used up all the colors in COLORFUL-POINTS-COLORS, we return a random one instead of an unused one."
22 (let ((colors colorful-points-colors))
23 (loop for color in
24 (mapcar (lambda (cell) (getf (overlay-get (cdr cell) 'face) :background)) colorful-points)
98df8d9 Kevin Brubeck Unhammer slurp the (or (car colors)…), doesn't make sense otherwise. Still can't ...
unhammer authored
25 do (setq colors (remove color colors)))
26 (or (car colors) (nth (random (length colorful-points-colors)) colorful-points-colors))))
0860aa4 Jonathan Rockway add colorful-points
authored
27
28 (defun colorful-points--overlay-for-window (win)
29 "Return the overlay representing WIN's point for the current buffer."
30 (let ((maybe-win (assoc win colorful-points)))
31 (if maybe-win (cdr maybe-win)
32 (let ((new (make-overlay 0 0 (current-buffer) t nil)))
33 (prog1 new
34 (setq colorful-points (cons (cons win new) colorful-points))
35 (overlay-put new 'face (list :background (colorful-points--next-color))))))))
36
37 (defun colorful-points-after-change (&rest ignored)
38 "Called to update the points after every change to the buffer.
39 Optional argument IGNORED is ignored."
40 (loop for (point . overlay) in
41 (mapcar (lambda (win) (cons (window-point win) (colorful-points--overlay-for-window win)))
42 (remove-if-not (lambda (window)
43 (equal (window-buffer window) (current-buffer)))
44 (loop for frame in (frame-list) nconcing (window-list frame))))
45 do (let ((first point)
46 (last (1+ point))
47 (eol (save-excursion (goto-char point) (line-end-position)))
48 (next-line-blank (save-excursion
49 (goto-char point)
50 (= (line-beginning-position 2) (line-end-position 2))))
51 (this-line-blank (save-excursion
52 (goto-char point)
53 (= (line-beginning-position) (line-end-position)))))
54 ;; (cond ((or (eq first eol) (eq first (point-max)))
55 ;; (setq first (1- point))
56 ;; (setq last point)))
57 ;; TODO - make this look nicer
58 (move-overlay overlay first last))))
Something went wrong with that request. Please try again.