-
Notifications
You must be signed in to change notification settings - Fork 6
/
eva.el
1891 lines (1675 loc) · 70.6 KB
/
eva.el
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
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
;;; eva.el --- Emacs virtual assistant -*- lexical-binding: t; -*-
;; Copyright (C) 2020-2024 Martin Edström
;; Author: Martin Edström <[email protected]>
;; URL: https://github.com/meedstrom/eva
;; Version: 0.5-pre
;; Created: 2020-12-03
;; Keywords: convenience
;; Package-Requires: ((emacs "27.1") (ts "0.3-pre") (s "1.12") (dash "2.19") (f "0.20.0") (ess "18.10.3snapshot") (named-timer "0.1") (transient "0.3.6"))
;; This file is not part of GNU Emacs.
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; See ./README.org or website: https://github.com/meedstrom/eva.
;; See also ./doc/eva.org or the Info node (eva).
;;; Code:
;; builtins
(require 'seq)
(require 'map)
(require 'subr-x)
(require 'cl-lib)
(require 'find-func) ;; find-library-name
(require 'transient) ;; Emacs 28 builtin
;; external
(require 'ts) ;; essential
(require 'named-timer) ;; essential
(require 'ess) ;; TODO: Drop this
(require 'dash)
(require 's)
(require 'f) ;; f-read and f-append are just nice
;; Mollify the byte compiler
(declare-function calendar-check-holidays "holidays")
(declare-function calendar-current-date "calendar")
(declare-function run-ess-r "ess-r-mode")
(declare-function ess-process-live-p "ess-inf")
(declare-function ess-execute "ess-inf")
(declare-function eww-current-url "eww")
(declare-function notifications-notify "notifications")
(declare-function notifications-get-capabilities "notifications")
(declare-function org-mac-idle-seconds "org-clock")
(declare-function org-read-date "org")
(defvar exwm-class-name)
(defvar exwm-title)
(define-obsolete-variable-alias 'eva-dbg-fn 'eva-debug-fn "2021-08-23")
(define-obsolete-variable-alias 'eva-ai-name 'eva-va-name "2021-08-23")
;;; Some user options
(defgroup eva nil "The Emacs virtual assistant."
:prefix "eva-"
:group 'convenience)
(defcustom eva-va-name "Eva"
"Your VA's name."
:group 'eva
:type 'string
:risky t)
(defcustom eva-user-birthday nil
"Your birthday, an YYYY-MM-DD string."
:group 'eva
:type 'string
:safe t)
(defcustom eva-user-name
(if (s-blank? user-full-name)
user-login-name
(-first-item (s-split " " user-full-name)))
"Name by which you prefer the VA to address you."
:group 'eva
:type 'string
:safe t)
(defcustom eva-user-short-title "Sojourner"
"A short title for you that works on its own.
May be capitalized or not, e.g. \"Mistress\" or \"human\"."
:group 'eva
:type 'string
:safe t)
(defcustom eva-sit-long 1
"Duration in seconds to pause for effect.
See also `eva-sit-medium' and `eva-sit-short'."
:group 'eva
:type 'float
:safe t)
(defcustom eva-sit-medium .8
"Duration in seconds to pause for effect.
See also `eva-sit-long' and `eva-sit-short'."
:group 'eva
:type 'float
:safe t)
(defcustom eva-sit-short .5
"Duration in seconds to pause for effect.
See also `eva-sit-long' and `eva-sit-medium'."
:group 'eva
:type 'float
:safe t)
(defcustom eva-presumptive nil
"Whether to skip some prompts and assume yes."
:group 'eva
:type 'boolean)
(defcustom eva-cache-dir-path
(expand-file-name "eva" (or (bound-and-true-p no-littering-var-directory)
user-emacs-directory))
"Directory for persistent files (not user datasets)."
:group 'eva
:type 'directory
:risky t)
;;; Common library
(defcustom eva-debug init-file-debug
"Whether to do debug stuff."
:group 'eva
:type 'boolean)
(defcustom eva-debug-fn (when eva-debug #'message)
"Control the behavior of `eva-dbg'.
Recommended options are nil, `message', `warn' and `error'."
:group 'eva
:type 'function
:safe t)
(defcustom eva-init-r t
"Whether to initialize an R session on startup."
:group 'eva
:type 'boolean)
(defvar eva--buffer-r nil)
(defvar eva-curr-fn nil)
(defvar eva-curr-dataset nil)
(defvar eva-curr-item nil)
(defvar eva-date (ts-now)
"Date to which to apply the current fn.
Can be set anytime to override the date to which some queries
apply, for example to log something for yesterday.
Mind that starting a new session resets this to today.")
(defvar eva--r-process nil)
(defun eva--init-r ()
"Spin up an R process and load needed R libraries.
Uses `run-ess-r' which is full of sanity checks (e.g. for cygwin
and text encoding), but creates an interactive R buffer which
unfortunately may surprise the user when they go to work on their
own R project."
(let ((default-directory (f-dirname (find-library-name "eva"))))
(when eva-init-r
(unless (and (buffer-live-p eva--buffer-r)
(ess-process-live-p eva--r-process))
(save-window-excursion
(setq eva--buffer-r (run-ess-r)))
(bury-buffer eva--buffer-r)
;; gotcha: only use `ess-with-current-buffer' for temp output buffers, not
;; for the process buffer
(with-current-buffer eva--buffer-r
(setq eva--r-process (get-process ess-local-process-name))
;; TODO: How to check if the script errors out?
(ess-execute "source(\"init.R\")" 'buffer))))))
(defun eva-dbg (&rest strings)
"Concat STRINGS and print them via function `eva-debug-fn'.
Do nothing if that is nil. Note that we don't do the
`format-message' business usual for `error' and its cousins.
Use the real `error' for that."
(when eva-debug-fn
(funcall eva-debug-fn (s-join " " strings))))
;; TODO: Catch typos like 03 meaning 30 minutes, not 3 hours.
(defun eva-parse-time-amount (input)
"Translate INPUT from hours or minutes into minutes.
If INPUT contains no \"h\" or \"m\", assume numbers above 20 are
minutes and numbers below are hours."
(declare (pure t) (side-effect-free t))
(let ((numeric-part (string-to-number input)))
(cond ((= 0 numeric-part) ;; strings without any number result in 0
nil) ;; save as a NA observation
((and (s-matches? "h.*m" input) (> numeric-part 0))
(warn "I'm not sophisticated enough to parse that"))
((s-matches? "h" input)
(* 60 numeric-part))
((s-matches? "m" input)
numeric-part)
((-> numeric-part (>= 20))
numeric-part)
(t
(* 60 numeric-part)))))
(defun eva-coerce-to-hh-mm (input)
"Coerce from INPUT matching HH:MM, HH or H, to HH:MM (24-h).
If \"am\" or \"pm\" present, assume input is in 12-hour clock."
(declare (pure t) (side-effect-free t))
(unless (s-matches? (rx num) input)
(error "%s" (concat "Invalid time: " input)))
(let* ((hhmm (or (cdr (s-match (rx (group (= 2 num)) punct (group (= 2 num)))
input))
(cdr (s-match (rx (group (= 1 num)) punct (group (= 2 num)))
input))
(s-match (rx (= 2 num)) input)
(s-match (rx (= 1 num)) input)))
(hour (string-to-number (car hhmm)))
(minute (string-to-number (or (cadr hhmm) "00"))))
(when (or (> hour 24)
(and (> hour 12)
(s-matches? (rx (or "pm" "am")) input)))
(error "%s" (concat "Invalid time: " input)))
(when (and (s-contains? "pm" input)
(/= 12 hour))
(cl-incf hour 12))
(when (and (s-contains? "am" input)
(= 12 hour))
(setq hour 0))
(when (= 24 hour)
(setq hour 23)
(setq minute 59))
(concat (when (< hour 10) "0")
(number-to-string hour) ":"
(when (< minute 10) "0")
(number-to-string minute))))
(defun eva-one-decimal (string)
"If STRING is a number, drop decimals beyond the first."
(when (stringp string)
(if (s-numeric? string)
;; leave integer as is
string
(car (s-match (rx (* nonl) "\." nonl) string)))))
(defmacro eva--process-output-to-string (program &rest args)
"Like `shell-command-to-string' without the shell intermediary.
You don't need a /bin/sh. PROGRAM and ARGS are passed on to
`call-process'."
(declare (debug (&rest form)))
`(with-temp-buffer
(call-process ,program nil (current-buffer) nil ,@args)
(buffer-string)))
(defmacro eva--process-output-to-number (program &rest args)
"Like `shell-command-to-string' without the shell intermediary.
Also converts the result to number. PROGRAM and ARGS are passed
on to `call-process'."
(declare (debug (&rest form)))
`(string-to-number (eva--process-output-to-string ,program ,@args)))
;;; Library for interactivity
(defcustom eva-chat-log-path
(convert-standard-filename
(expand-file-name "chat.log" eva-cache-dir-path))
"Where to save chat log across sessions. Can be nil."
:group 'eva
:type 'file
:safe t)
(defvar eva--queue nil)
(defvar eva--midprompt-keymap
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C--") #'eva-decrement-date)
(define-key map (kbd "C-+") #'eva-increment-date)
(define-key map (kbd "C-0") #'eva-set-date-today)))
(defvar eva--just-typed-k nil)
(defvar eva--last-chatted nil
"Timestamp updated whenever the chat is written to.")
(defun eva-buffer-chat ()
"Buffer where the VA sends its messages."
(or (get-buffer (concat "*" eva-va-name ": chat log*"))
(let ((buf (get-buffer-create
(concat "*" eva-va-name ": chat log*"))))
(with-current-buffer buf
(eva-chat-mode)
(setq-local auto-save-visited-mode nil)
(setq-local require-final-newline nil)
(buffer-disable-undo)
(visual-line-mode)
(and eva-chat-log-path
(f-exists? eva-chat-log-path)
(insert-file-contents eva-chat-log-path))
(setq-local buffer-read-only t))
buf)))
(defun eva--y-or-n-p-insert-k ()
"Mostly like `y-or-n-p-insert-y'."
(interactive)
(delete-minibuffer-contents)
(insert "y")
(setq eva--just-typed-k t)
(exit-minibuffer))
(defun eva-ynp (&rest strings)
"Wrapper around `y-or-n-p'.
Concatenates STRINGS into one prompt, prints it to the chat
buffer, binds certain hotkeys."
(let* (;; (default-y-or-n-p-map y-or-n-p-map)
;; (default-cmd (lookup-key y-or-n-p-map (kbd "k")))
;; TODO: Also show which log file we're applying to
(background-info (concat "[Applying to date: "
(ts-format "%Y %b %d" eva-date)
"]\n"))
(prompt (string-join strings)))
(unwind-protect
(progn
(pop-to-buffer (eva-buffer-chat))
(eva-emit prompt)
(define-key y-or-n-p-map (kbd "h") #'eva-dispatch)
(define-key y-or-n-p-map (kbd "<SPC>") #'eva-dispatch)
(define-key y-or-n-p-map (kbd "k") #'eva--y-or-n-p-insert-k)
(setq-local buffer-read-only nil)
(let ((result (y-or-n-p (concat background-info prompt))))
(with-silent-modifications
(if eva--just-typed-k
(progn
(setq eva--just-typed-k nil)
(eva-emit-same-line " Okay..."))
(if result
(eva-emit-same-line " Yes.")
(eva-emit-same-line " No."))))
result))
(setq-local buffer-read-only t)
(dolist (x '("o" "i" "k" "<SPC>"))
(define-key y-or-n-p-map (kbd x) #'y-or-n-p-insert-other)))))
(defun eva-read (prompt &optional collection default)
"Wrapper for `completing-read'.
PROMPT, COLLECTION and DEFAULT are as in that function.
Echo both prompts and responses to the chat buffer, prepend
metadata to PROMPT, check for special keyword input, etc."
(eva-emit prompt)
(set-transient-map eva--midprompt-keymap #'minibufferp)
(let* ((background-info (concat "[Applying to date: "
(ts-format "%Y %b %d" eva-date)
"]\n"))
(extra-collection '("/skip" "/help"))
(input (completing-read
(concat background-info
(ts-format "<%H:%M> ")
prompt
(when (stringp default)
(concat
" (default " default "): ")))
(append collection extra-collection)
nil nil nil nil
(when (stringp default)
default))))
(eva-emit-same-line input)
(if (eva-check-special-input input)
input
nil)))
(defun eva-read-string
(prompt &optional initial-input history default-value)
"Like `eva-read' but call `read-string' internally.
All of PROMPT, INITIAL-INPUT, HISTORY, DEFAULT-VALUE are passed
to that function, though PROMPT is prepended with extra info."
(eva-emit prompt)
(set-transient-map eva--midprompt-keymap #'minibufferp)
(let* ((background-info (concat "[Applying to date: "
(ts-format "%Y, %b %d]\n" eva-date)
"[Type /skip to skip, or /help for help.]\n"))
(input (read-string
(concat background-info
(ts-format "<%H:%M> ")
prompt)
initial-input
history
default-value)))
(eva-emit-same-line input)
(if (eva-check-special-input input)
input
nil)))
(defun eva-emit (&rest strings)
"Write a line to the chat buffer, made from STRINGS.
Returns the completed string so you can pass it to `message', for
example."
(let ((new-date-maybe (if (/= (ts-day (ts-now))
(ts-day eva--last-chatted))
(concat "\n\n"
(ts-format "%A, %d %B %Y")
(eva--holiday-maybe)
"\n")
""))
(msg (concat "\n<" (ts-format "%H:%M") "> " (string-join strings))))
(with-current-buffer (eva-buffer-chat)
(goto-char (point-max))
(with-silent-modifications
(delete-blank-lines)
(insert new-date-maybe)
(insert msg))))
(setq eva--last-chatted (ts-fill (ts-now)))
(string-join strings))
(defun eva-emit-same-line (&rest strings)
"Print STRINGS to the chat buffer without newline."
(let ((msg (string-join strings)))
(with-current-buffer (eva-buffer-chat)
(goto-char (point-max))
(with-silent-modifications
(insert msg)))
(setq eva--last-chatted (ts-fill (ts-now)))
msg))
;;; Library for greeting messages
(defvar eva-greetings
'((concat "Welcome back, " eva-user-short-title ".")
(concat "Nice to see you again, " eva-user-name ".")
(concat "Greetings, " eva-user-name "."))
"Greeting phrases which can initiate a conversation.
A quoted list of expressions.")
;; NOTE: I considered making external variables for morning, day and evening
;; lists, but users might also want to change the daytime boundaries or
;; even add new boundaries.
(defun eva-daytime-appropriate-greetings ()
"Return different greeting strings appropriate to daytime."
(cond ((> 5 (ts-hour (ts-now)))
(list (concat "You're up late, " eva-user-short-title)
"Burning the midnight oil?"))
((> 10 (ts-hour (ts-now)))
(list (concat "Good morning, " eva-user-name ".")
"Good morning!"
"The stars shone upon us last night."))
((> 16 (ts-hour (ts-now)))
(list "Good day!"))
(t
(list "Good evening!"
"Pleasant evening to you!"))))
(defun eva--holiday-maybe ()
"If today's a holiday, return a suitable string for `eva-emit'.
Else return a blank string."
(require 'calendar)
(require 'holidays)
(if-let (foo (calendar-check-holidays (calendar-current-date)))
(concat " -- " (s-join " " foo))
""))
(defun eva-greeting-curt ()
"Return a greeting appropriate in the midst of a workday.
Because if you've already exchanged good mornings, it's weird to
do so again."
(seq-random-elt `("Hello" "Hi" "Hey")))
(defun eva-greeting ()
"Return a greeting string."
(let ((bday (ts-parse eva-user-birthday)))
(cond ((equal (ts-format "%F" bday) (ts-format "%F" (ts-now)))
(concat "Happy birthday, " eva-user-name "."))
;; If it's morning, always use a variant of "good morning"
((> 10 (ts-hour (ts-now)) 5)
(eval (seq-random-elt (eva-daytime-appropriate-greetings))
t))
(t
(eval (seq-random-elt
(append eva-greetings
(-list (eva-daytime-appropriate-greetings))))
t)))))
(defun eva-greeting-standalone ()
"Return a greeting that expects to be followed by nothing.
No prompts, no debug message, no info. Suitable for
`notifications-notify' or `startup-echo-area-message'. A
superset of `eva-greeting'. Mutually exclusive with
`eva-greeting-curt'."
(eval (seq-random-elt
(append eva-greetings
(-list (eva-daytime-appropriate-greetings))
'("How may I help?")))))
;;; Library for chimes
(defcustom eva-chime-sound-path
(convert-standard-filename
(expand-file-name
;; From https://freesound.org/people/josepharaoh99/sounds/380482/
"assets/Chime Notification-380482.wav"
;; From https://bigsoundbank.com/detail-0319-knock-on-a-glass-door-1.html
;; "assets/DOORKnck_Knock on a glass door 1 (ID 0319)_BSB.wav"
(f-dirname (find-library-name "eva"))))
"Sound to play when a welcomer is triggered unannounced."
:group 'eva
:type 'file)
(defcustom eva-play-sounds nil
"Whether to play sounds."
:group 'eva
:type 'boolean)
(defun eva--chime-aural ()
"Play a sound."
(and eva-play-sounds
(executable-find "aplay")
(f-exists? eva-chime-sound-path)
(start-process "aplay" nil "aplay" eva-chime-sound-path)))
(defun eva--chime-visual ()
"Give the fringes a flash of color and fade out."
(let ((colors '((.1 . "green")
(.2 . "#aca")
(.3 . "#7a7")
(.4 . "#696")
(.5 . "#363"))))
(let ((orig (face-background 'fringe)))
(dolist (x colors)
(run-with-timer (car x) nil
#'set-face-background 'fringe (cdr x)))
(run-with-timer .6 nil #'set-face-background 'fringe orig))
(when (facep 'solaire-fringe-face)
(let ((orig (face-background 'solaire-fringe-face)))
(dolist (x colors)
(run-with-timer (car x) nil
#'set-face-background 'solaire-fringe-face (cdr x)))
(run-with-timer .6 nil
#'set-face-background 'solaire-fringe-face orig)))
nil))
;;; Library for files
(defun eva--transact-buffer-onto-file (buffer path)
"Append contents of BUFFER to file at PATH, emptying BUFFER."
(mkdir (f-dirname path) t)
(with-current-buffer buffer
(eva-append-safely (buffer-string) path)
(delete-region (point-min) (point-max))))
(defun eva--count-successes-today (fn)
"Add up occurrences of timestamps for FN in related log files."
(let ((dataset (eva-item-dataset (eva-item-by-fn fn)))
(log (expand-file-name (concat "successes-" (symbol-name fn))
eva-cache-dir-path)))
(if (and dataset
(f-exists? dataset))
(length (eva-tsv-entries-by-date dataset))
;; FIXME: this has only unixstamps, while eva-tsv-entries-by-date scans
;; for datestamps, so this will always be zero
(if (f-exists? log)
(length (eva-tsv-entries-by-date log))
(message "No dataset or log file found for %s %s."
(symbol-name fn)
"(may simply not exist yet)")
0))))
(defun eva-write-safely (text path)
"Write TEXT to file at PATH if the content differs.
Also revert any buffer visiting it, or signal an error if there
are unsaved changes."
(let ((buf (find-buffer-visiting path)))
(and buf
(buffer-modified-p buf)
(error "Unsaved changes in open buffer: %s" (buffer-name buf)))
(unless (and (f-exists? path)
(string= text (f-read path 'utf-8)))
(f-write text 'utf-8 path)
(and buf (with-current-buffer buf
(revert-buffer))))))
(defun eva-append-safely (text path)
"Append TEXT to file at PATH.
Also revert any buffer visiting it, or warn if there are unsaved
changes and append to a file named PATH_errors."
(let ((buf (find-buffer-visiting path))
(errors-path (concat path "_errors")))
(and buf
(buffer-modified-p buf)
(warn "Unsaved changes in open buffer: %s, writing to %s"
(buffer-name buf) errors-path)
(f-append text 'utf-8 errors-path))
(unless (= 0 (length text)) ;; no unnecessary disk writes
(f-append text 'utf-8 path)
(and buf (with-current-buffer buf
(revert-buffer))))))
;; NOTE: Actually unused inside this package, but may be useful.
;; WONTFIX: check for recent activity (user awake thru the night) and keep
;; returning t
(defun eva-logged-today-p (path)
"Check for references to today's date inside file at PATH.
Does this by searching for a YYYY-MM-DD datestamp. Returns t on
success, nil on failure."
(when (f-exists? path)
;; don't act like it's a new day if the time is <5am.
(let ((day (if (> 5 (ts-hour (ts-now)))
(ts-dec 'day 1 (ts-now))
(ts-now))))
(with-temp-buffer
(insert-file-contents-literally path)
(when (search-forward (ts-format "%F" day) nil t)
t)))))
(defun eva-first-today-line-in-file (path &optional ts)
"In file at PATH, get the first line that refers to today.
Does this by searching for a YYYY-MM-DD datestamp matching today
or a ts object TS."
(with-temp-buffer
(insert-file-contents-literally path)
(search-forward (ts-format "%F" ts))
(buffer-substring (line-beginning-position) (line-end-position))))
(defun eva-last-datestamp-in-file (path)
"Get the last match of YYYY-MM-DD in PATH.
Beware that if PATH has instances of such where you don't expect
it (in additional columns), you might not get the datestamp you
meant to get."
(with-temp-buffer
(insert-file-contents-literally path)
(goto-char (point-max))
(re-search-backward (rx (= 4 digit) "-" (= 2 digit) "-" (= 2 digit)))
(buffer-substring (point) (+ 10 (point)))))
(defun eva-tsv-all-entries (path)
"Return the contents of a .tsv at PATH as a Lisp list."
(with-temp-buffer
(insert-file-contents-literally path)
(flush-lines (rx bol eol))
(let ((rows (s-split "\n" (buffer-string) t)))
(--map (s-split "\t" it) rows))))
;; HACK: too strong assumption
(defun eva-tsv-last-timestamp* (path)
"In .tsv at PATH, get the second field of last row."
(with-temp-buffer
(insert-file-contents-literally path)
(goto-char (point-max))
(when (looking-back "^" nil) ;; if trailing newline
(forward-line -1))
(goto-char (line-beginning-position))
(search-forward "\t")
(buffer-substring (point) (- (search-forward "\t") 1))))
;; TODO: Search for unix-stamps too.
(defun eva-tsv-entries-by-date (path &optional ts)
"Return the contents of a .tsv at PATH as a Lisp list.
Filters for rows containing a YYYY-MM-DD datestamp matching
either today or the date of optional ts object TS."
(if (f-exists? path)
(with-temp-buffer
(insert-file-contents-literally path)
(let (x)
(while (search-forward (ts-format "%F" ts) nil t)
(push (split-string (buffer-substring (line-beginning-position)
(line-end-position))
"\t")
x)
(goto-char (line-end-position)))
x))
(warn "File doesn't exist: %s" path)
nil))
(defun eva-tsv-last-row (path)
"In .tsv at PATH, get last row as a Lisp list."
(with-temp-buffer
(insert-file-contents-literally path)
(goto-char (point-max))
(when (looking-back "^" nil) ;; if empty line
(forward-line -1))
(split-string (buffer-substring (line-beginning-position)
(line-end-position))
"\t")))
(defun eva-tsv-last-value (path)
"In .tsv at PATH, get the value of last row, last field."
(when (f-exists? path)
(with-temp-buffer
(insert-file-contents-literally path)
(goto-char (point-max))
(search-backward "\t")
(forward-char)
(buffer-substring (point) (line-end-position)))))
(cl-defun eva-tsv-append
(path &rest fields &key float-time &allow-other-keys)
"Append a line to the file located at PATH.
Create the file and its parent directories if it doesn't exist,
and make sure the line begins on a newline. Treat each argument
in FIELDS... as a separate data field, inserting a tab character
in between, and warn if a field contains a tab character.
For database purposes (which you may not need), FIELDS is
prepended with a field for the Unix timestamp representing
\"posted time\" i.e. right now, the time the row was added. If
time is also an actual variable you want to track, add a separate
field containing something like the output of `(ts-format
eva-date)'. The first field is not for that. Optional
key FLOAT-TIME, if non-nil, means to use a float instead of
integer for the first field."
(declare (indent defun))
(unless (f-exists? path)
(make-empty-file path t))
(let* ((fields (-replace nil "" fields))
(newline-maybe (if (s-ends-with-p "\n" (f-read-bytes path))
""
"\n"))
;; don't do a blank initial line on a new file
(newline-maybe-really (if (string= "" (f-read-bytes path))
""
newline-maybe))
(posted (if float-time
(ts-format "%s.%N")
(ts-format "%s")))
(text (s-join "\t" fields))
(new-text (concat newline-maybe-really posted "\t" text))
(errors-path (concat path "_errors")))
(cond
((--any-p (s-contains? "\t" it) fields)
(warn "Entry had tabs inside fields, wrote to %s" errors-path)
(f-append (concat new-text "\tERROR: TABS INSIDE FIELD") 'utf-8 errors-path)
nil)
((s-contains? "\n" text)
(warn "Entry had newlines, wrote to %s" errors-path)
(f-append (concat new-text "\tERROR: NEWLINES") 'utf-8 errors-path)
nil)
(t
(eva-append-safely new-text path)
t))))
;;; Handle idle & reboots & crashes
(defcustom eva-idle-log-path
(convert-standard-filename "~/self-data/idle.tsv")
"Location of the idleness log."
:group 'eva
:type 'file)
(defcustom eva-fallback-to-emacs-idle nil
"Track Emacs idle rather than turn off under unknown OS/DE.
Not recommended, as the idleness log will be meaningless unless
you never use a graphical program. You'll end up with the
situation where clicking on Emacs after long time in your web
browser triggers the return-from-idle-hook.
Note that even EXWM will not update `current-idle-time' while an
X window is in focus."
:group 'eva
:type 'boolean)
(defcustom eva-idle-threshold-secs-short (* 10 60)
"Duration in seconds, above which the user is considered idle."
:group 'eva
:type 'integer)
(defcustom eva-idle-threshold-secs-long (* 90 60)
"Be idle at least this many seconds to start a session on return."
:group 'eva
:type 'integer)
(defcustom eva-return-from-idle-hook
'(eva--log-idle
eva-session-from-idle)
"Hook run when user returns from a period of idleness.
Note: An Emacs startup also counts as a return from idleness.
You'll probably want your hook to be conditional on some value of
`eva-length-of-last-idle', which at startup is calculated
from the last Emacs shutdown or crash (technically, last time
the mode was enabled)."
:group 'eva
:type '(hook :options (eva--log-idle
eva-session-from-idle)))
(defcustom eva-periodic-hook
'(eva--save-vars-to-disk
eva--save-buffer-logs-to-disk)
"Hook run periodically as long as the user is not idle.
Many things do not need to be done while the user is idle, so
think about whether your function does. If not, put them here."
:group 'eva
:type '(hook :options (eva--save-vars-to-disk
eva--save-buffer-logs-to-disk)))
(defvar eva--x11idle-program-name nil)
(defvar eva--idle-secs-fn nil)
(defvar eva--last-online nil)
(defvar eva--idle-beginning nil)
(defvar eva-length-of-last-idle 0
"Length of the last idle/offline period, in seconds.
Becomes set after that period ends and should be available at the
time `eva-return-from-idle-hook' is run.")
(defun eva--idle-secs ()
"Number of seconds user has now been idle, as told by the system.
Not to be confused with `eva-length-of-last-idle'."
(funcall eva--idle-secs-fn))
(defun eva--idle-secs-x11 ()
"Like `org-x11-idle-seconds' without /bin/sh or org."
(/ (eva--process-output-to-number eva--x11idle-program-name)
1000))
;; Wow, it's really surprising to do
;; (progn (sleep-for 1) (float-time (current-idle-time)))
;; because that's just (float-time nil) which does return a value
;; so the above form returns sth you don't expect
(defun eva--idle-secs-emacs ()
"Same as `org-emacs-idle-seconds'.
Digression: Should honestly be submitted to Emacs,
`current-idle-time' is... not normal."
(let ((idle-time (current-idle-time)))
(if idle-time
(float-time idle-time)
0)))
(defun eva--idle-secs-gnome ()
"Check Mutter's idea of idle time, even on Wayland."
;; https://unix.stackexchange.com/questions/396911/how-can-i-tell-if-a-user-is-idle-in-wayland
(let ((idle-ms
(string-to-number
(car (s-match (rx space (* digit) eol)
(eva--process-output-to-string
"dbus-send"
"--print-reply"
"--dest=org.gnome.Mutter.IdleMonitor"
"/org/gnome/Mutter/IdleMonitor/Core"
"org.gnome.Mutter.IdleMonitor.GetIdletime"))))))
(/ idle-ms 1000)))
(defun eva--log-idle ()
"Log chunk of idle time to disk."
(eva-tsv-append eva-idle-log-path
(ts-format)
(number-to-string (/ (round eva-length-of-last-idle) 60))))
;; This trio of functions handles many edge cases elegantly. Modify with care.
(defun eva--start-next-timer (&optional assume-idle)
"Start one or the other timer depending on idleness.
If ASSUME-IDLE is non-nil, skip the idle check and associated
overhead."
(if (or assume-idle (eva-idle-p))
(named-timer-run :eva 2 nil #'eva--user-is-idle t)
(named-timer-run :eva 111 nil #'eva--user-is-present)))
(defun eva--user-is-present ()
"Do stuff assuming the user is active (not idle).
This function is called by `eva--start-next-timer'
repeatedly for as long as the user is active (not idle).
Runs `eva-periodic-hook'."
;; Guard the case where the user puts the computer to sleep manually, which
;; means this function will still be queued to run when the computer wakes.
;; If the time difference is suddenly big, hand off to the other function.
(if (> (ts-diff (ts-now) eva--last-online)
eva-idle-threshold-secs-short)
(eva--user-is-idle)
(setq eva--last-online (ts-fill (ts-now)))
(setq eva--idle-beginning (ts-fill (ts-now)))
(eva--start-next-timer)
;; Run hooks last, in case they contain bugs.
(run-hooks 'eva-periodic-hook)))
;; NOTE: This runs rapidly b/c it should react quickly on user returning.
;; TODO: Actually, just install a post-command-hook that removes itself.
(defun eva--user-is-idle (&optional decrement)
"Do stuff assuming the user is idle.
This function is called by `eva--start-next-timer'
repeatedly for as long as the user is idle.
When DECREMENT is non-nil, decrement `eva--idle-beginning'
to correct for the time it took to reach idle status.
When the user comes back, this function will be called one last
time, at which point the idleness condition will fail and it sets
`eva-length-of-last-idle' and runs
`eva-return-from-idle-hook'. That it has to run exactly
once with a failing condition that normally succeeds, as opposed
to running never or forever, is the reason it has to be a
separate function from `eva--user-is-present'."
(setq eva--last-online (ts-now))
(if (eva-idle-p)
(eva--start-next-timer 'assume-idle)
;; Take the idle threshold into account and correct the idle begin point.
(when decrement
(ts-decf (ts-sec eva--idle-beginning)
eva-idle-threshold-secs-short))
(setq eva-length-of-last-idle (ts-diff (ts-now) eva--idle-beginning))
(unwind-protect
(run-hooks 'eva-return-from-idle-hook)
(setq eva--idle-beginning (ts-fill (ts-now)))
(eva--start-next-timer))))
(defun eva-idle-p ()
"Idled longer than `eva-idle-threshold-secs-short'?"
(> (eva--idle-secs) eva-idle-threshold-secs-short))
;;; Items
;; Q: What's cl-defstruct? A: https://nullprogram.com/blog/2018/02/14/
;; NOTE: If you change the order of keys, eva--mem-recover will set the
;; wrong values henceforth! You'd better use `eva--mem-nuke-var' on
;; `eva-items' then.
;; TODO Put :fn first, easier inspection
(cl-defstruct (eva-item
(:constructor eva-item-create)
(:copier nil))
(dismissals 0)
(min-hours-wait 3)
last-called ;; almost always filled-in
fn ;; primary key (must be unique)
max-calls-per-day
max-successes-per-day
max-entries-per-day
lookup-posted-time
dataset
;; name ;; truly-unique key (if reusing fn in two objects for some reason)
)
(defvar eva-items)
(defvar eva-disabled-fns nil
"Which members of `eva-items' to avoid processing.
Referred to by their :fn value.")
(defun eva-check-special-input (input)
"Check INPUT for keywords like \"/skip\" and react specially."
(cond ((string-match-p "^/s" input) ;; /skip
(if (and (< 1 (length eva--queue))
(member eva-curr-fn eva--queue))
;; Try to proceed to next item
;;
;; REVIEW: does this actually work now since it checks
;; minibufferp? we need maybe to call
;; abort-recursive-edit too?
(progn
(cl-incf (eva-item-dismissals eva-curr-item))
(setq eva--queue (cl-remove eva-curr-fn eva--queue :count 1))
(eva-resume))
;; Just cancel the session
(abort-recursive-edit))
nil)
((string-match-p "^/h" input) ;; /help
(eva-dispatch)
(abort-recursive-edit)
nil)
(t input)))
(defun eva--pending-p (fn)
"Return t if FN is due to be called."
(let* ((i (eva-item-by-fn fn))
(dataset (eva-item-dataset i))
(max-entries (eva-item-max-entries-per-day i))
(max-successes (eva-item-max-successes-per-day i))
(lookup-posted-time (eva-item-lookup-posted-time i))
(dismissals (eva-item-dismissals i))
(min-hrs-wait (eva-item-min-hours-wait i))
(min-secs-wait (* 60 60 min-hrs-wait))
(successes-today (eva--count-successes-today fn))
(successes-specified-and-exceeded
(and successes-today
max-successes
(>= successes-today max-successes)))
(last-called (make-ts :unix (or (eva-item-last-called i) 0)))
(called-today (and (= (ts-day last-called) (ts-day (ts-now)))
(> (ts-hour last-called) 4)))
(recently-logged