blob: 8b7c963f3180f9d3c77e7dbe8a20e0a4d5a7f808 (
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
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
|
;;; test-org-roam-config-copy-and-move.el --- Tests for org-roam copy/move bodies -*- lexical-binding: t; -*-
;;; Commentary:
;; Sibling tests cover the org-roam hook wiring, slug/demote/format
;; helpers, and the link description extractor. This file covers the
;; bodies of the two larger interactive commands:
;;
;; cj/org-roam-copy-todo-to-today
;; cj/move-org-branch-to-roam
;;; Code:
(require 'ert)
(require 'cl-lib)
(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory))
;; user-constants pulls in the constants the module reads at load.
(require 'user-constants)
(require 'org)
;; `org-refile' is autoloaded; resolve it now so `cl-letf' has a real
;; function cell to replace in the test.
(require 'org-refile)
(require 'org-roam-config)
;; Top-level defvars so let-bindings reach the dynamic variable under
;; lexical scope.
(defvar org-refile-keep nil)
(defvar org-roam-dailies-capture-templates nil)
(defvar org-after-refile-insert-hook nil)
(defvar org-roam-directory nil)
;;; cj/org-roam-copy-todo-to-today
(ert-deftest test-org-roam-copy-todo-refiles-to-today-when-different-file ()
"Normal: copy-todo-to-today calls `org-refile' targeted at today's file
when today-file differs from the current buffer file."
(let* ((source (make-temp-file "cj-roam-source-" nil ".org"))
(today (make-temp-file "cj-roam-today-" nil ".org"))
refile-args)
(unwind-protect
(with-temp-buffer
(setq buffer-file-name source)
(cl-letf (((symbol-function 'org-roam-dailies--capture)
(lambda (&rest _)
(set-buffer (find-file-noselect today))
(goto-char (point-max))))
((symbol-function 'org-refile)
(lambda (&rest args) (setq refile-args args))))
(cj/org-roam-copy-todo-to-today))
(should refile-args)
;; `org-refile' was called with (nil nil ("Completed Tasks" today nil pos))
(let ((target (nth 2 refile-args)))
(should (equal "Completed Tasks" (nth 0 target)))
(should (equal (file-truename today) (file-truename (nth 1 target))))))
(when (get-file-buffer today) (kill-buffer (get-file-buffer today)))
(delete-file source)
(delete-file today))))
(ert-deftest test-org-roam-copy-todo-saves-target-buffer ()
"Normal: after the refile into today's journal, the target buffer
must not be left modified. An unsaved journal buffer is what causes
Emacs to prompt about unsaved buffers at shutdown."
(let ((source (make-temp-file "cj-roam-source-" nil ".org"))
(today (make-temp-file "cj-roam-today-" nil ".org")))
(unwind-protect
(with-temp-buffer
(setq buffer-file-name source)
(cl-letf (((symbol-function 'org-roam-dailies--capture)
(lambda (&rest _)
(set-buffer (find-file-noselect today))
(goto-char (point-max))))
((symbol-function 'org-refile)
(lambda (&rest _)
;; Simulate org-refile inserting into the
;; target buffer (which marks it modified).
(with-current-buffer (find-file-noselect today)
(goto-char (point-max))
(insert "* refiled content\n")))))
(cj/org-roam-copy-todo-to-today))
(let ((target-buffer (find-buffer-visiting today)))
(should target-buffer)
(should-not (buffer-modified-p target-buffer))))
(when (get-file-buffer today) (kill-buffer (get-file-buffer today)))
(delete-file source)
(delete-file today))))
(ert-deftest test-org-roam-copy-todo-skips-when-already-today ()
"Boundary: when the current buffer already visits today's file, no
refile is issued (same source and target)."
(let ((today (make-temp-file "cj-roam-same-" nil ".org"))
called)
(unwind-protect
(with-temp-buffer
(setq buffer-file-name today)
(cl-letf (((symbol-function 'org-roam-dailies--capture)
(lambda (&rest _)
(set-buffer (find-file-noselect today))
(goto-char (point-max))))
((symbol-function 'org-refile)
(lambda (&rest _) (setq called t))))
(cj/org-roam-copy-todo-to-today))
(should-not called))
(when (get-file-buffer today) (kill-buffer (get-file-buffer today)))
(delete-file today))))
;;; cj/move-org-branch-to-roam
(ert-deftest test-org-roam-move-branch-creates-roam-file ()
"Normal: move-branch writes a roam file with the demoted subtree and
syncs the roam db."
(let* ((roam-dir (file-name-as-directory
(make-temp-file "cj-roam-move-dir-" t)))
(org-roam-directory roam-dir)
(synced nil))
(unwind-protect
(cl-letf (((symbol-function 'require) (lambda (&rest _) t))
((symbol-function 'org-id-new)
(lambda () "11111111-2222-3333-4444-555555555555"))
((symbol-function 'org-roam-db-sync)
(lambda (&rest _) (setq synced t)))
((symbol-function 'yes-or-no-p) (lambda (&rest _) t))
((symbol-function 'message) #'ignore))
(with-temp-buffer
(org-mode)
(insert "* My Heading\n** Sub heading\nbody text\n")
(goto-char (point-min))
(cj/move-org-branch-to-roam))
(should synced)
(let* ((files (directory-files roam-dir t "\\.org\\'"))
(written (car files)))
(should files)
(should (string-match-p "-my-heading\\.org\\'" written))
(with-temp-buffer
(insert-file-contents written)
(let ((text (buffer-string)))
(should (string-match-p ":ID:" text))
(should (string-match-p "11111111-2222-3333-4444-555555555555" text))
(should (string-match-p "#\\+TITLE: My Heading" text))
(should (string-match-p "#\\+FILETAGS: Topic" text))
;; The subtree gets demoted to level 1 -- the original
;; level-1 heading stays as "* My Heading" and the
;; level-2 child becomes "** Sub heading".
(should (string-match-p "^\\* My Heading" text))
(should (string-match-p "^\\*\\* Sub heading" text))))))
(delete-directory roam-dir t))))
(ert-deftest test-org-roam-move-branch-write-failure-preserves-source ()
"Error: if writing the roam file fails, the source subtree is NOT cut.
The destructive cut must come after a successful write, so a failed write
(here: an unwritable roam directory) can't lose the subtree."
(let ((org-roam-directory "/no/such/cj-roam-move-dir/"))
(cl-letf (((symbol-function 'require) (lambda (&rest _) t))
((symbol-function 'org-id-new) (lambda () "id-1"))
((symbol-function 'org-roam-db-sync) #'ignore)
((symbol-function 'yes-or-no-p) (lambda (&rest _) t))
((symbol-function 'message) #'ignore))
(with-temp-buffer
(org-mode)
(insert "* My Heading\n** Sub heading\nbody text\n")
(goto-char (point-min))
(ignore-errors (cj/move-org-branch-to-roam))
;; The write failed before the cut, so the subtree is intact.
(should (string-match-p "My Heading" (buffer-string)))
(should (string-match-p "body text" (buffer-string)))))))
(ert-deftest test-org-roam-move-branch-errors-outside-heading ()
"Error: move-branch outside an org heading signals `user-error'."
(cl-letf (((symbol-function 'require) (lambda (&rest _) t)))
(with-temp-buffer
(org-mode)
(insert "plain body text, no heading at all\n")
(goto-char (point-min))
(should-error (cj/move-org-branch-to-roam) :type 'user-error))))
(provide 'test-org-roam-config-copy-and-move)
;;; test-org-roam-config-copy-and-move.el ends here
|
