blob: be7fc38cfb74d135de56cf4392146bf1992ddf17 (
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
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
|
;;; test-org-webclipper-commands.el --- Tests for org-webclipper commands + protocol -*- lexical-binding: t; -*-
;;; Commentary:
;; Sibling `test-org-webclipper-process.el' covers
;; `cj/--process-webclip-content'. This file covers:
;;
;; cj/webclipper-ensure-initialized
;; cj/org-protocol-webclip
;; cj/org-protocol-webclip-handler
;; cj/org-webclipper-EWW
;;
;; All org-protocol / org-capture / org-web-tools / w3m / eww
;; primitives are stubbed.
;;; Code:
(require 'ert)
(require 'cl-lib)
(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory))
(require 'org-webclipper)
(defvar org-protocol-protocol-alist nil
"Stub for `org-protocol-protocol-alist'.")
(defvar org-capture-templates nil
"Stub for `org-capture-templates'.")
(defvar webclipped-file "/tmp/test-webclipped.org"
"Stub for the user-constants `webclipped-file' destination.")
;;; cj/webclipper-ensure-initialized
(ert-deftest test-webclipper-ensure-initialized-registers-templates ()
"Normal: first call sets up the W and w capture templates and flips the
initialized flag. Protocol registration lives in the
`with-eval-after-load 'org-protocol' block at the bottom of the module --
asserted separately below in `test-webclipper-protocol-registered-via-after-load'."
(let ((cj/webclipper-initialized nil)
(org-protocol-protocol-alist nil)
(org-capture-templates nil))
(cl-letf (((symbol-function 'require) (lambda (&rest _) t)))
(cj/webclipper-ensure-initialized))
(should cj/webclipper-initialized)
(should (assoc "W" org-capture-templates))
(should (assoc "w" org-capture-templates))))
(ert-deftest test-webclipper-protocol-registered-via-after-load ()
"Loading org-webclipper installs a `with-eval-after-load 'org-protocol' block
that registers the webclip entry. Providing `'org-protocol' fires the block."
(let ((org-protocol-protocol-alist nil))
(provide 'org-protocol)
(should (assoc "webclip" org-protocol-protocol-alist))))
(ert-deftest test-webclipper-ensure-initialized-is-idempotent ()
"Boundary: second call doesn't re-register or duplicate templates."
(let ((cj/webclipper-initialized nil)
(org-protocol-protocol-alist nil)
(org-capture-templates nil))
(cl-letf (((symbol-function 'require) (lambda (&rest _) t)))
(cj/webclipper-ensure-initialized)
(let ((proto-len (length org-protocol-protocol-alist))
(tmpl-len (length org-capture-templates)))
(cj/webclipper-ensure-initialized)
(should (= (length org-protocol-protocol-alist) proto-len))
(should (= (length org-capture-templates) tmpl-len))))))
;;; cj/org-protocol-webclip
(ert-deftest test-webclipper-protocol-binds-url-title-during-capture ()
"Normal: the protocol handler makes url+title visible to the capture call."
(let ((cj/webclipper-initialized t)
(seen-url nil) (seen-title nil) (capture-key nil))
(cl-letf (((symbol-function 'org-capture)
(lambda (_arg k)
(setq capture-key k
seen-url cj/--webclip-url
seen-title cj/--webclip-title))))
(cj/org-protocol-webclip
'(:url "https://example.com" :title "Hello")))
(should (equal seen-url "https://example.com"))
(should (equal seen-title "Hello"))
(should (equal capture-key "W"))))
(ert-deftest test-webclipper-protocol-leaves-no-stale-state ()
"Boundary: after the protocol capture returns, no url/title remains bound."
(let ((cj/webclipper-initialized t))
(cl-letf (((symbol-function 'org-capture) #'ignore))
(cj/org-protocol-webclip '(:url "https://example.com" :title "Hello")))
(should (null cj/--webclip-url))
(should (null cj/--webclip-title))))
(ert-deftest test-webclipper-protocol-aborted-capture-clears-state ()
"Error: a capture that errors mid-flow still leaves no stale url/title."
(let ((cj/webclipper-initialized t))
(cl-letf (((symbol-function 'org-capture)
(lambda (&rest _) (error "simulated capture abort"))))
(ignore-errors (cj/org-protocol-webclip '(:url "https://example.com"))))
(should (null cj/--webclip-url))
(should (null cj/--webclip-title))))
(ert-deftest test-webclipper-protocol-defaults-title-when-missing ()
"Boundary: a missing title in INFO becomes \"Untitled\" during the capture."
(let ((cj/webclipper-initialized t)
(seen-title nil))
(cl-letf (((symbol-function 'org-capture)
(lambda (&rest _) (setq seen-title cj/--webclip-title))))
(cj/org-protocol-webclip '(:url "https://x.test")))
(should (equal seen-title "Untitled"))))
;;; cj/org-protocol-webclip-handler
(ert-deftest test-webclipper-protocol-handler-errors-when-no-url ()
"Error: handler with no bound url signals an error."
(let ((cj/--webclip-url nil)
(cj/--webclip-title "Whatever"))
(cl-letf (((symbol-function 'require) (lambda (&rest _) t)))
(should-error (cj/org-protocol-webclip-handler) :type 'error))))
(ert-deftest test-webclipper-protocol-handler-errors-when-pandoc-missing ()
"Error: handler signals a user-error naming pandoc when it's not on PATH."
(let ((cj/--webclip-url "https://example.com")
(cj/--webclip-title "Title"))
(cl-letf (((symbol-function 'require) (lambda (&rest _) t))
((symbol-function 'executable-find) (lambda (_) nil)))
(let ((err (should-error (cj/org-protocol-webclip-handler)
:type 'user-error)))
(should (string-match-p "pandoc" (cadr err)))))))
(ert-deftest test-webclipper-protocol-handler-proceeds-when-pandoc-present ()
"Normal: with pandoc on PATH the guard passes through to conversion."
(let ((cj/--webclip-url "https://example.com")
(cj/--webclip-title "Title"))
(cl-letf (((symbol-function 'require) (lambda (&rest _) t))
((symbol-function 'executable-find) (lambda (_) "/usr/bin/pandoc"))
((symbol-function 'org-web-tools--url-as-readable-org)
(lambda (_) "* Page Title\n** Sub heading\nBody.\n"))
((symbol-function 'message) #'ignore))
(should (string-match-p "Body"
(cj/org-protocol-webclip-handler))))))
(ert-deftest test-webclipper-protocol-handler-returns-processed-content ()
"Normal: handler converts the bound URL into processed org content."
(let ((cj/--webclip-url "https://example.com")
(cj/--webclip-title "Title"))
(cl-letf (((symbol-function 'require) (lambda (&rest _) t))
((symbol-function 'executable-find) (lambda (_) "/usr/bin/pandoc"))
((symbol-function 'org-web-tools--url-as-readable-org)
(lambda (_) "* Page Title\n** Sub heading\nBody.\n"))
((symbol-function 'message) #'ignore))
(let ((out (cj/org-protocol-webclip-handler)))
;; The first H1 is stripped, sub-heading is demoted.
(should (string-match-p "^\\*\\*\\* Sub heading" out))
(should (string-match-p "Body" out))))))
(ert-deftest test-webclipper-protocol-handler-wraps-fetch-error ()
"Error: a fetch failure is wrapped in a clear error message."
(let ((cj/--webclip-url "https://example.com")
(cj/--webclip-title "Title"))
(cl-letf (((symbol-function 'require) (lambda (&rest _) t))
((symbol-function 'org-web-tools--url-as-readable-org)
(lambda (_) (error "network down"))))
(let ((err (should-error (cj/org-protocol-webclip-handler) :type 'error)))
(should (string-match-p "Failed to clip" (cadr err)))))))
;;; cj/org-webclipper-EWW
(ert-deftest test-webclipper-eww-copies-from-eww-buffer ()
"Normal: an eww-mode source buffer routes through `org-eww-copy-for-org-mode'."
(let ((source (generate-new-buffer "*test-webclip-eww*"))
(called nil)
(kill-ring '("captured-org-content")))
(with-current-buffer source (setq major-mode 'eww-mode))
(unwind-protect
(cl-letf (((symbol-function 'cj/webclipper-ensure-initialized) #'ignore)
((symbol-function 'org-capture-get)
(lambda (k) (when (eq k :original-buffer) source)))
((symbol-function 'org-eww-copy-for-org-mode)
(lambda () (setq called 'eww))))
(should (equal (cj/org-webclipper-EWW) "captured-org-content")))
(when (buffer-live-p source) (kill-buffer source)))
(should (eq called 'eww))))
(ert-deftest test-webclipper-eww-copies-from-w3m-buffer ()
"Normal: a w3m-mode source buffer routes through `org-w3m-copy-for-org-mode'."
(let ((source (generate-new-buffer "*test-webclip-w3m*"))
(called nil)
(kill-ring '("captured-w3m")))
(with-current-buffer source (setq major-mode 'w3m-mode))
(unwind-protect
(cl-letf (((symbol-function 'cj/webclipper-ensure-initialized) #'ignore)
((symbol-function 'org-capture-get)
(lambda (k) (when (eq k :original-buffer) source)))
((symbol-function 'org-w3m-copy-for-org-mode)
(lambda () (setq called 'w3m))))
(should (equal (cj/org-webclipper-EWW) "captured-w3m")))
(when (buffer-live-p source) (kill-buffer source)))
(should (eq called 'w3m))))
(ert-deftest test-webclipper-eww-errors-on-unsupported-mode ()
"Error: a non-eww/w3m source buffer signals."
(let ((source (generate-new-buffer "*test-webclip-other*")))
(with-current-buffer source (setq major-mode 'fundamental-mode))
(unwind-protect
(cl-letf (((symbol-function 'cj/webclipper-ensure-initialized) #'ignore)
((symbol-function 'org-capture-get)
(lambda (k) (when (eq k :original-buffer) source))))
(should-error (cj/org-webclipper-EWW) :type 'error))
(when (buffer-live-p source) (kill-buffer source)))))
(provide 'test-org-webclipper-commands)
;;; test-org-webclipper-commands.el ends here
|
