summaryrefslogtreecommitdiff
path: root/.emacs.d/site-lisp/redtick.el
blob: 9ca4ed797bde8d5706a95296d2d854baf7520bf6 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
;;; redtick.el --- Smallest pomodoro timer (1 char) -*- lexical-binding: t -*-

;; Copyright (C) 2022  Sean Whitton

;; Simplified ver. of F. Febles's Unlicensed redtick.el.  My work is GPL-3+.

;;; Code:

(defconst redtick--ticks
  (let ((map (make-mode-line-mouse-map 'mouse-1 #'redtick)))
    (mapcar (pcase-lambda (`(,time ,char ,colour))
	      (cons time
		    (concat (propertize
			     char 'pointer 'hand 'local-map map
			     'face `(:inherit mode-line :foreground ,colour))
			    " ")))
	    '((187.5 "█" "#ffff66") (187.5 "▇" "#ffcc66")
	      (187.5 "▆" "#cc9966") (187.5 "▅" "#ff9966")
	      (187.5 "▄" "#cc6666") (187.5 "▃" "#ff6666")
	      (187.5 "▂" "#ff3366") (187.5 "▁" "#ff0066")

	      (37.5 "█" "#00cc66") (37.5 "▇" "#33cc66")
	      (37.5 "▆" "#66cc66") (37.5 "▅" "#00ff66")
	      (37.5 "▄" "#33ff66") (37.5 "▃" "#66ff66")
	      (37.5 "▂" "#99ff66") (37.5 "▁" "#ccff66")

	      (nil "✓" "#cf6a4c")))))

(defvar redtick--tick)
(defvar redtick--timer)

(defun redtick--update-tick (ticks)
  (when (caar ticks)
    (setq redtick--timer
	  (run-at-time (caar ticks) nil #'redtick--update-tick (cdr ticks))))
  (setq redtick--tick (cdar ticks))
  (force-mode-line-update t))

;;;###autoload
(define-minor-mode redtick-mode
  "Little Pomodoro timer in the mode line."
  :global t
  (setq redtick--timer nil redtick--tick (cdar (last redtick--ticks)))
  (when redtick-mode
    (let ((tick '(:eval (and redtick-mode
			     (if (mode-line-window-selected-p)
				 redtick--tick
			       "  "))))
	  (format (default-value 'mode-line-format)))
      (unless (member tick format)
	(catch 'done
	  (while (setq format (cdr format))
	    (when (eq (cadr format) 'mode-line-buffer-identification)
	      (throw 'done (push tick (cdr format))))))
	(force-mode-line-update t)))))

;;;###autoload
(defun redtick ()
  (interactive)
  (redtick-mode 1)
  (redtick--update-tick redtick--ticks))

(provide 'redtick)

;;; redtick.el ends here