-
Notifications
You must be signed in to change notification settings - Fork 1
Expand file tree
/
Copy pathorg-autoclock.el
More file actions
93 lines (76 loc) · 3.24 KB
/
org-autoclock.el
File metadata and controls
93 lines (76 loc) · 3.24 KB
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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
;;; -*- lexical-binding: t; -*-
;;; org-autoclock.el -- Automatically clock in for certain files.
(require 'org)
(defvar org-autoclock-logfile "~/.org-autoclock-log.org"
"Log file where the session durations are stored.")
(defvar org-autoclock-default-task-name "XINU"
"Default name for the clocked task.")
(defvar org-autoclock-timer-delay 5
"Delay in seconds before timer automatically clocks in or out.")
(defvar org-autoclock-timer nil "Timer for `org-autoclock`.")
(defun org-autoclock (&optional arg)
"Automatically clock in and out in Org when editing certain files.
The clock used will be the last one in Org.
If none exists, signal the user."
(interactive "P")
(cond ((org-autoclock-doing-taskp)
(when (equal (org-clock-in-last) "No last clock")
(user-error "Please clock in to an Org task before using org-autoclock.")))
(t (org-clock-out nil t))))
(defun org-autoclock-doing-taskp (&optional arg)
"Return true if we are doing the specified task. (For now, C code.)"
(interactive "P")
(and (buffer-file-name) (string-match-p "\\.[cSh]$" (buffer-file-name))))
(defun org-autoclock-start (&optional arg)
"Start automatically clocking into a desired task."
(interactive "P")
(with-current-buffer (find-file-noselect org-autoclock-logfile)
(goto-char (point-max))
(insert (format "\n* %s" org-autoclock-default-task-name))
(org-clock-in)
(org-clock-out)
(save-buffer))
(setq org-autoclock-timer (run-with-timer 1 org-autoclock-timer-delay 'org-autoclock)))
(defun org-autoclock-stop (&optional arg)
"Cancel automatic clocking. Clock out of any running clock."
(interactive "P")
(when org-autoclock-timer
(cancel-timer org-autoclock-timer))
(org-clock-out nil t)
(with-current-buffer (find-file-noselect org-autoclock-logfile t)
(save-buffer)))
;;; HACK: Have to use this giant workaround because Emacs 24 doesn't have
;;; inhibit-message.
(defadvice message (around suppress-messages)
"Make `message' a no-op."
(ignore))
(defadvice org-clock-in-last (around org-clock-in-last-suppress-messages)
"Suppress messages within this function.
Adapted from https://superuser.com/questions/669701/emacs-disable-some-minibuffer-messages."
(ad-enable-advice 'message 'around 'suppress-messages)
(ad-activate 'message)
(unwind-protect
ad-do-it
(ad-disable-advice 'message 'around 'suppress-messages)
(ad-activate 'message)))
(defadvice org-clock-out (around org-clock-out-suppress-messages)
"Suppress messages within this function.
Adapted from https://superuser.com/questions/669701/emacs-disable-some-minibuffer-messages."
(ad-enable-advice 'message 'around 'suppress-messages)
(ad-activate 'message)
(unwind-protect
ad-do-it
(ad-disable-advice 'message 'around 'suppress-messages)
(ad-activate 'message)))
(ad-activate 'org-clock-in-last)
(ad-activate 'org-clock-out)
(ert-deftest org-autoclock--no-running-clock ()
(with-temp-buffer
(org-clock-out nil t)
;; Should not fail when there's no running clock.
(should (or (org-autoclock) t))))
;; Manual test:
;; Kill Emacs without clocking out -> org-autoclock should automatically clock
;; out and *save* the log file. No dangling clocks.
(add-hook 'kill-emacs-hook (lambda () (org-autoclock-stop)))
(provide 'org-autoclock)