test/test-org.sgl — sigil-org

1(import (sigil test)

2 (sigil org)

3 (sigil sxml)

4 (sigil string))

6;; ============================================================

7;; Metadata

8;; ============================================================

10(test-group "metadata"

11 (test "title metadata"

12 (let ((doc (org->sxml "#+TITLE: My Document\n\nContent")))

13 (assert-equal 'org-document (sxml-tag doc))

14 (assert-equal "My Document" (sxml-attr-ref doc 'title))))

16 (test "multiple metadata"

17 (let ((doc (org->sxml "#+TITLE: Test\n#+AUTHOR: Alice\n\nContent")))

18 (assert-equal "Test" (sxml-attr-ref doc 'title))

19 (assert-equal "Alice" (sxml-attr-ref doc 'author))))

21 (test "no metadata"

22 (let ((doc (org->sxml "* Heading\n\nText")))

23 (assert-equal 'org-document (sxml-tag doc))

24 (assert-equal '() (sxml-attributes doc)))))

26;; ============================================================

27;; Headlines

28;; ============================================================

30(test-group "headlines"

31 (test "simple headline"

32 (let* ((doc (org->sxml "* Hello"))

33 (hl (car (sxml-content doc))))

34 (assert-equal 'headline (sxml-tag hl))

35 (assert-equal 1 (sxml-attr-ref hl 'level))))

37 (test "nested headlines"

38 (let* ((doc (org->sxml "* Top\n** Sub"))

39 (top (car (sxml-content doc))))

40 (assert-equal 'headline (sxml-tag top))

41 (assert-equal 1 (sxml-attr-ref top 'level))

42 ;; Sub-headline should be nested

43 (let ((children (filter (lambda (x)

44 (and (pair? x) (eq? (car x) 'headline)))

45 (cdr top))))

46 (assert-true (> (length children) 0)))))

48 (test "headline with TODO"

49 (let* ((doc (org->sxml "* TODO Fix the bug"))

50 (hl (car (sxml-content doc))))

51 (assert-equal "TODO" (sxml-attr-ref hl 'todo))))

53 (test "headline with tags"

54 (let* ((doc (org->sxml "* My heading :tag1:tag2:"))

55 (hl (car (sxml-content doc))))

56 (assert-equal "tag1 tag2" (sxml-attr-ref hl 'tags))))

58 (test "headline with priority"

59 (let* ((doc (org->sxml "* [#A] Important task"))

60 (hl (car (sxml-content doc))))

61 (assert-equal "A" (sxml-attr-ref hl 'priority)))))

63;; ============================================================

64;; Property Drawers

65;; ============================================================

67(test-group "property drawers"

68 (test "property drawer"

69 (let* ((doc (org->sxml "* Heading\n:PROPERTIES:\n:CUSTOM_ID: my-id\n:END:\n\nText"))

70 (hl (car (sxml-content doc)))

71 (drawer (let find ((elems (cdr hl)))

72 (cond

73 ((null? elems) #f)

74 ((and (pair? (car elems))

75 (eq? (caar elems) 'property-drawer))

76 (car elems))

77 (else (find (cdr elems)))))))

78 (assert-true (pair? drawer)))))

80;; ============================================================

81;; Source Blocks

82;; ============================================================

84(test-group "source blocks"

85 (test "source block with language"

86 (let* ((doc (org->sxml "#+BEGIN_SRC scheme\n(define x 42)\n#+END_SRC"))

87 (block (car (sxml-content doc))))

88 (assert-equal 'src-block (sxml-tag block))

89 (assert-equal "scheme" (sxml-attr-ref block 'language))))

91 (test "source block preserves content"

92 (let* ((doc (org->sxml "#+BEGIN_SRC python\nprint(\"hello\")\nprint(\"world\")\n#+END_SRC"))

93 (block (car (sxml-content doc)))

94 (text (car (sxml-content block))))

95 (assert-true (string-contains? text "hello"))

96 (assert-true (string-contains? text "world")))))

98;; ============================================================

99;; Other Blocks

100;; ============================================================

101

102(test-group "other blocks"

103 (test "quote block"

104 (let* ((doc (org->sxml "#+BEGIN_QUOTE\nSome quote\n#+END_QUOTE"))

105 (block (car (sxml-content doc))))

106 (assert-equal 'quote-block (sxml-tag block))))

107

108 (test "example block"

109 (let* ((doc (org->sxml "#+BEGIN_EXAMPLE\nSome example\n#+END_EXAMPLE"))

110 (block (car (sxml-content doc))))

111 (assert-equal 'example-block (sxml-tag block)))))

112

113;; ============================================================

114;; Inline Markup

115;; ============================================================

116

117(test-group "inline markup"

118 (test "bold text"

119 (let* ((doc (org->sxml "This is *bold* text"))

120 (para (car (sxml-content doc)))

121 (has-bold (let find ((elems (cdr para)))

122 (cond

123 ((null? elems) #f)

124 ((and (pair? (car elems))

125 (eq? (caar elems) 'bold))

126 #t)

127 (else (find (cdr elems)))))))

128 (assert-true has-bold)))

129

130 (test "italic text"

131 (let* ((doc (org->sxml "This is /italic/ text"))

132 (para (car (sxml-content doc)))

133 (has-italic (let find ((elems (cdr para)))

134 (cond

135 ((null? elems) #f)

136 ((and (pair? (car elems))

137 (eq? (caar elems) 'italic))

138 #t)

139 (else (find (cdr elems)))))))

140 (assert-true has-italic)))

141

142 (test "code text"

143 (let* ((doc (org->sxml "Use ~my-function~ here"))

144 (para (car (sxml-content doc)))

145 (has-code (let find ((elems (cdr para)))

146 (cond

147 ((null? elems) #f)

148 ((and (pair? (car elems))

149 (eq? (caar elems) 'code))

150 #t)

151 (else (find (cdr elems)))))))

152 (assert-true has-code)))

153

154 (test "verbatim text"

155 (let* ((doc (org->sxml "The value is =42= here"))

156 (para (car (sxml-content doc)))

157 (has-verb (let find ((elems (cdr para)))

158 (cond

159 ((null? elems) #f)

160 ((and (pair? (car elems))

161 (eq? (caar elems) 'verbatim))

162 #t)

163 (else (find (cdr elems)))))))

164 (assert-true has-verb))))

165

166;; ============================================================

167;; Links

168;; ============================================================

169

170(test-group "links"

171 (test "link with description"

172 (let* ((doc (org->sxml "Visit [[https://example.com][Example]]"))

173 (para (car (sxml-content doc)))

174 (link (let find ((elems (cdr para)))

175 (cond

176 ((null? elems) #f)

177 ((and (pair? (car elems))

178 (eq? (caar elems) 'a))

179 (car elems))

180 (else (find (cdr elems)))))))

181 (assert-true (pair? link))

182 (assert-equal "https://example.com" (sxml-attr-ref link 'href))))

183

184 (test "link without description"

185 (let* ((doc (org->sxml "See [[https://example.com]]"))

186 (para (car (sxml-content doc)))

187 (link (let find ((elems (cdr para)))

188 (cond

189 ((null? elems) #f)

190 ((and (pair? (car elems))

191 (eq? (caar elems) 'a))

192 (car elems))

193 (else (find (cdr elems)))))))

194 (assert-true (pair? link)))))

195

196;; ============================================================

197;; Lists

198;; ============================================================

199

200(test-group "lists"

201 (test "unordered list"

202 (let* ((doc (org->sxml "- item one\n- item two\n- item three"))

203 (list-elem (car (sxml-content doc))))

204 (assert-equal 'unordered-list (sxml-tag list-elem))))

205

206 (test "ordered list"

207 (let* ((doc (org->sxml "1. first\n2. second\n3. third"))

208 (list-elem (car (sxml-content doc))))

209 (assert-equal 'ordered-list (sxml-tag list-elem))))

210

211 (test "list with checkbox"

212 (let* ((doc (org->sxml "- [ ] unchecked\n- [x] checked"))

213 (list-elem (car (sxml-content doc)))

214 (items (sxml-content list-elem)))

215 (assert-equal 2 (length items)))))

216

217;; ============================================================

218;; Paragraphs and Rules

219;; ============================================================

220

221(test-group "paragraphs"

222 (test "simple paragraph"

223 (let* ((doc (org->sxml "Hello world"))

224 (para (car (sxml-content doc))))

225 (assert-equal 'paragraph (sxml-tag para))))

226

227 (test "multiple paragraphs"

228 (let* ((doc (org->sxml "First paragraph.\n\nSecond paragraph."))

229 (content (sxml-content doc)))

230 (assert-equal 2 (length content)))))

231

232(test-group "horizontal rules"

233 (test "horizontal rule"

234 (let* ((doc (org->sxml "Above\n\n-----\n\nBelow"))

235 (content (sxml-content doc))

236 (has-hr (let find ((elems content))

237 (cond

238 ((null? elems) #f)

239 ((and (pair? (car elems))

240 (eq? (caar elems) 'hr))

241 #t)

242 (else (find (cdr elems)))))))

243 (assert-true has-hr))))

244

245;; ============================================================

246;; Timestamps

247;; ============================================================

248

249(test-group "timestamps"

250 (test "active timestamp"

251 (let* ((doc (org->sxml "Scheduled for <2026-02-20 Fri>"))

252 (para (car (sxml-content doc)))

253 (has-ts (let find ((elems (cdr para)))

254 (cond

255 ((null? elems) #f)

256 ((and (pair? (car elems))

257 (eq? (caar elems) 'timestamp))

258 #t)

259 (else (find (cdr elems)))))))

260 (assert-true has-ts)))

261

262 (test "inactive timestamp"

263 (let* ((doc (org->sxml "Created [2026-02-20 Fri]"))

264 (para (car (sxml-content doc)))

265 (ts (let find ((elems (cdr para)))

266 (cond

267 ((null? elems) #f)

268 ((and (pair? (car elems))

269 (eq? (caar elems) 'timestamp))

270 (car elems))

271 (else (find (cdr elems)))))))

272 (assert-true (pair? ts))

273 (assert-equal "inactive" (sxml-attr-ref ts 'type)))))

274

275;; ============================================================

276;; Comments

277;; ============================================================

278

279(test-group "comments"

280 (test "comment lines are skipped"

281 (let* ((doc (org->sxml "# This is a comment\nVisible text"))

282 (content (sxml-content doc)))

283 ;; Should only have the paragraph, not the comment

284 (assert-equal 1 (length content))

285 (assert-equal 'paragraph (sxml-tag (car content))))))

286

287;; ============================================================

288;; Tables

289;; ============================================================

290

291(test-group "tables"

292 (test "simple table"

293 (let* ((doc (org->sxml "| A | B |\n| 1 | 2 |"))

294 (content (sxml-content doc))

295 (tbl (car content)))

296 (assert-equal 'table (sxml-tag tbl))

297 ;; Two rows, first is header (th), second is data (td)

298 (let ((rows (sxml-content tbl)))

299 (assert-equal 2 (length rows))

300 (assert-equal 'tr (sxml-tag (car rows)))

301 (assert-equal 'th (sxml-tag (car (sxml-content (car rows)))))

302 (assert-equal 'td (sxml-tag (car (sxml-content (cadr rows))))))))

303

304 (test "table with separator row"

305 (let* ((doc (org->sxml "| Name | Value |\n|------+-------|\n| foo | 42 |"))

306 (content (sxml-content doc))

307 (tbl (car content)))

308 (assert-equal 'table (sxml-tag tbl))

309 ;; Separator row is skipped, so 2 data rows

310 (let ((rows (sxml-content tbl)))

311 (assert-equal 2 (length rows))

312 ;; First row is header

313 (assert-equal 'th (sxml-tag (car (sxml-content (car rows))))))))

314

315 (test "table with inline markup in cells"

316 (let* ((doc (org->sxml "| Key | Desc |\n|-----+------|\n| ~C-x~ | =save= |"))

317 (content (sxml-content doc))

318 (tbl (car content))

319 (rows (sxml-content tbl))

320 (data-row (cadr rows))

321 (cells (sxml-content data-row)))

322 ;; First cell should contain code element

323 (let ((cell1-content (sxml-content (car cells))))

324 (assert-true (pair? cell1-content))

325 (assert-equal 'code (sxml-tag (car cell1-content))))))

326

327 (test "single row table"

328 (let* ((doc (org->sxml "| only | row |"))

329 (content (sxml-content doc))

330 (tbl (car content))

331 (rows (sxml-content tbl)))

332 ;; Single row should just be a tr

333 (assert-equal 1 (length rows))

334 (assert-equal 'tr (sxml-tag (car rows))))))

335

336;; ============================================================

337;; Integration

338;; ============================================================

339

340(test-group "integration"

341 (test "full document"

342 (let ((doc (org->sxml

343 (string-append

344 "#+TITLE: My Document\n"

345 "#+AUTHOR: Test User\n"

346 "\n"

347 "* Introduction\n"

348 "\n"

349 "This is a *bold* introduction with a [[https://example.com][link]].\n"

350 "\n"

351 "** Details\n"

352 "\n"

353 "- Item one\n"

354 "- Item two\n"

355 "\n"

356 "#+BEGIN_SRC scheme\n"

357 "(define x 42)\n"

358 "#+END_SRC\n"))))

359 (assert-equal 'org-document (sxml-tag doc))

360 (assert-equal "My Document" (sxml-attr-ref doc 'title))

361 (assert-equal "Test User" (sxml-attr-ref doc 'author)))))

362

363(run-tests)