blob: 7925da2b9973158fcb972d54fcd3634d33d4f243 (
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
|
;;; 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-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 '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-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
|
