feat: Add sigil-org Org Mode parser

Message

Parses Org Mode documents into SXML, supporting headlines with TODO state and tags, document metadata, property drawers, source/quote/example blocks, inline markup (bold, italic, code, verbatim, underline, strikethrough), links, ordered/unordered lists with checkboxes, timestamps, horizontal rules, and comments.

29 tests covering all element types.

Changed

 package.sgl       |  15 ++++
 src/sigil/org.sgl | 725 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 test/test-org.sgl | 314 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 1054 insertions(+)

Diff

package.sgladded

@@ -0,0 +1,15 @@

;;; sigil-org - Org Mode parser

;;;

;;; Parses Org Mode text into SXML for use with (sigil sxml).

(package

name: "sigil-org"

version: "0.5.0"

description: "Org Mode parser producing SXML output"

url: "https://codeberg.org/sigil/sigil"

+10

license: "BSD-3-Clause"

+11

authors: (list "David Wilson <[email protected]>")

+12

+13

dependencies: (list

+14

(from-workspace name: "sigil-stdlib")

+15

(from-workspace name: "sigil-peg")))

src/sigil/org.sgladded

@@ -0,0 +1,725 @@

;;; (sigil org) - Org Mode Parser

;;;

;;; Parses Org Mode text into an SXML document tree. Targets the elements

;;; commonly used in System Crafters content.

;;;

;;; ## Basic Usage

;;;

;;; ```scheme

;;; (import (sigil org))

+10

;;;

+11

;;; (org->sxml "* Hello\n\nSome text.")

+12

;;; ; => (org-document

+13

;;; ; (headline (@ (level 1)) "Hello"

+14

;;; ; (section (paragraph "Some text."))))

+15

;;; ```

+16

;;;

+17

;;; ## Supported Elements

+18

;;;

+19

;;; | Element | Syntax |

+20

;;; |------------------|-------------------------------------------|

+21

;;; | Metadata | `#+TITLE: value`, `#+AUTHOR: value` |

+22

;;; | Headlines | `* Level 1`, `** Level 2`, with tags |

+23

;;; | Property drawers | `:PROPERTIES:` ... `:END:` |

+24

;;; | Source blocks | `#+BEGIN_SRC lang` ... `#+END_SRC` |

+25

;;; | Other blocks | `#+BEGIN_QUOTE` ... `#+END_QUOTE` |

+26

;;; | Text markup | `*bold*`, `/italic/`, `~code~`, `=verb=` |

+27

;;; | Links | `[[url][desc]]`, `[[url]]` |

+28

;;; | Lists | `- item`, `1. item`, checkboxes |

+29

;;; | Horizontal rules | `-----` (5+ dashes on a line) |

+30

;;; | Comments | Lines starting with `#` (not `#+`) |

+31

;;; | Timestamps | `<2026-02-20 Fri>`, `[2026-02-20 Fri]` |

+32

+33

(define-library (sigil org)

+34

(import (sigil string)

+35

(sigil peg)

+36

(sigil io))

+37

(export

+38

org->sxml

+39

org-file->sxml)

+40

+41

(begin

+42

+43

;; ============================================================

+44

;; String Utilities

+45

;; ============================================================

+46

+47

(define (string->lines str)

+48

(let ((len (string-length str)))

+49

(let loop ((start 0) (i 0) (lines '()))

+50

(cond

+51

((>= i len)

+52

(reverse (if (> i start)

+53

(cons (substring str start i) lines)

+54

lines)))

+55

((char=? (string-ref str i) #\newline)

+56

(loop (+ i 1) (+ i 1)

+57

(cons (substring str start i) lines)))

+58

(else

+59

(loop start (+ i 1) lines))))))

+60

+61

(define (string-drop str n)

+62

(if (>= n (string-length str))

+63

""

+64

(substring str n (string-length str))))

+65

+66

(define (count-leading str ch)

+67

(let ((len (string-length str)))

+68

(let loop ((i 0))

+69

(if (and (< i len) (char=? (string-ref str i) ch))

+70

(loop (+ i 1))

+71

i))))

+72

+73

(define (string-ci-starts-with? str prefix)

+74

(let ((slen (string-length str))

+75

(plen (string-length prefix)))

+76

(and (>= slen plen)

+77

(equal? (string-downcase (substring str 0 plen))

+78

(string-downcase prefix)))))

+79

+80

;; ============================================================

+81

;; Line Classification

+82

;; ============================================================

+83

+84

(define (blank-line? line)

+85

(string-blank? line))

+86

+87

(define (headline? line)

+88

(and (> (string-length line) 0)

+89

(char=? (string-ref line 0) #\*)

+90

(let ((stars (count-leading line #\*)))

+91

(and (< stars (string-length line))

+92

(char=? (string-ref line stars) #\space)))))

+93

+94

(define (metadata-line? line)

+95

(and (string-starts-with? line "#+")

+96

(not (string-ci-starts-with? line "#+BEGIN_"))

+97

(not (string-ci-starts-with? line "#+END_"))))

+98

+99

(define (comment-line? line)

+100

(and (> (string-length line) 0)

+101

(char=? (string-ref line 0) #\#)

+102

(or (= (string-length line) 1)

+103

(not (char=? (string-ref line 1) #\+)))))

+104

+105

(define (horizontal-rule? line)

+106

(and (>= (string-length (string-trim line)) 5)

+107

(let ((trimmed (string-trim line)))

+108

(let loop ((i 0))

+109

(if (>= i (string-length trimmed))

+110

#t

+111

(if (char=? (string-ref trimmed i) #\-)

+112

(loop (+ i 1))

+113

#f))))))

+114

+115

(define (block-begin? line)

+116

(string-ci-starts-with? (string-trim line) "#+BEGIN_"))

+117

+118

(define (block-end? line)

+119

(string-ci-starts-with? (string-trim line) "#+END_"))

+120

+121

(define (property-drawer-start? line)

+122

(equal? (string-trim (string-downcase line)) ":properties:"))

+123

+124

(define (property-drawer-end? line)

+125

(equal? (string-trim (string-downcase line)) ":end:"))

+126

+127

(define (unordered-list-item? line)

+128

(let ((trimmed (string-trim-start line)))

+129

(and (>= (string-length trimmed) 2)

+130

(or (char=? (string-ref trimmed 0) #\-)

+131

(char=? (string-ref trimmed 0) #\+))

+132

(char=? (string-ref trimmed 1) #\space))))

+133

+134

(define (ordered-list-item? line)

+135

(let ((trimmed (string-trim-start line)))

+136

(and (>= (string-length trimmed) 3)

+137

(char-numeric? (string-ref trimmed 0))

+138

(let loop ((i 1))

+139

(cond

+140

((>= i (string-length trimmed)) #f)

+141

((char-numeric? (string-ref trimmed i)) (loop (+ i 1)))

+142

((and (char=? (string-ref trimmed i) #\.)

+143

(< (+ i 1) (string-length trimmed))

+144

(char=? (string-ref trimmed (+ i 1)) #\space))

+145

#t)

+146

(else #f))))))

+147

+148

(define (char-numeric? c)

+149

(and (char>=? c #\0) (char<=? c #\9)))

+150

+151

;; ============================================================

+152

;; Metadata Parsing

+153

;; ============================================================

+154

+155

(define (parse-metadata-line line)

+156

(let* ((content (string-drop line 2))

+157

(colon (string-index content (lambda (c) (char=? c #\:)))))

+158

(if colon

+159

(let ((key (string-downcase (string-trim (substring content 0 colon))))

+160

(value (string-trim (string-drop content (+ colon 1)))))

+161

(cons (string->symbol key) value))

+162

#f)))

+163

+164

;; ============================================================

+165

;; Headline Parsing

+166

;; ============================================================

+167

+168

(define (parse-headline line)

+169

(let* ((stars (count-leading line #\*))

+170

(rest (string-trim (string-drop line (+ stars 1))))

+171

(attrs (list (list 'level stars))))

+172

;; Parse optional TODO keyword

+173

(let-values (((todo rest2) (parse-todo rest)))

+174

(let ((attrs2 (if todo (cons (list 'todo todo) attrs) attrs)))

+175

;; Parse optional priority

+176

(let-values (((priority rest3) (parse-priority rest2)))

+177

(let ((attrs3 (if priority (cons (list 'priority priority) attrs2) attrs2)))

+178

;; Parse optional tags at end

+179

(let-values (((tags title) (parse-tags rest3)))

+180

(let ((attrs4 (if (null? tags) attrs3

+181

(cons (list 'tags (string-join tags " ")) attrs3))))

+182

(values (string-trim title) (reverse attrs4))))))))))

+183

+184

(define (parse-todo text)

+185

(cond

+186

((string-starts-with? text "TODO ")

+187

(values "TODO" (string-drop text 5)))

+188

((string-starts-with? text "DONE ")

+189

(values "DONE" (string-drop text 5)))

+190

((string-starts-with? text "WAIT ")

+191

(values "WAIT" (string-drop text 5)))

+192

((string-starts-with? text "NEXT ")

+193

(values "NEXT" (string-drop text 5)))

+194

(else (values #f text))))

+195

+196

(define (parse-priority text)

+197

(if (and (>= (string-length text) 4)

+198

(string-starts-with? text "[#")

+199

(char=? (string-ref text 3) #\])

+200

(char-alphabetic? (string-ref text 2)))

+201

(values (list->string (list (string-ref text 2)))

+202

(string-trim (string-drop text 4)))

+203

(values #f text)))

+204

+205

(define (parse-tags text)

+206

(let ((len (string-length text)))

+207

(if (and (> len 1)

+208

(char=? (string-ref text (- len 1)) #\:))

+209

;; Find the start of the tag section (last sequence of :tag1:tag2:)

+210

(let loop ((i (- len 2)))

+211

(cond

+212

((< i 0) (values '() text))

+213

((char=? (string-ref text i) #\:)

+214

;; Check if preceded by a space or at start

+215

(if (or (= i 0) (char=? (string-ref text (- i 1)) #\space))

+216

(let* ((tag-str (substring text (+ i 1) (- len 1)))

+217

(tags (string-split tag-str ":"))

+218

(title (string-trim (substring text 0 i))))

+219

(values tags title))

+220

(loop (- i 1))))

+221

((or (char-alphabetic? (string-ref text i))

+222

(char-numeric? (string-ref text i))

+223

(char=? (string-ref text i) #\_)

+224

(char=? (string-ref text i) #\@))

+225

(loop (- i 1)))

+226

(else (values '() text))))

+227

(values '() text))))

+228

+229

;; ============================================================

+230

;; Property Drawer Parsing

+231

;; ============================================================

+232

+233

(define (parse-property-line line)

+234

(let ((trimmed (string-trim line)))

+235

(if (and (> (string-length trimmed) 1)

+236

(char=? (string-ref trimmed 0) #\:))

+237

(let ((colon2 (string-index (string-drop trimmed 1)

+238

(lambda (c) (char=? c #\:)))))

+239

(if colon2

+240

(let ((key (substring trimmed 1 (+ colon2 1)))

+241

(value (string-trim (string-drop trimmed (+ colon2 3)))))

+242

(list 'property key value))

+243

#f))

+244

#f)))

+245

+246

;; ============================================================

+247

;; Block Parsing

+248

;; ============================================================

+249

+250

(define (parse-block-header line)

+251

(let* ((trimmed (string-trim line))

+252

(prefix-end (string-index trimmed (lambda (c) (char=? c #\_))))

+253

(after-underscore (string-drop trimmed (+ prefix-end 1)))

+254

(space-pos (string-index after-underscore

+255

(lambda (c) (char=? c #\space)))))

+256

(if space-pos

+257

(let ((block-type (string-downcase (substring after-underscore 0 space-pos)))

+258

(args (string-trim (string-drop after-underscore (+ space-pos 1)))))

+259

(values block-type args))

+260

(values (string-downcase after-underscore) ""))))

+261

+262

;; ============================================================

+263

;; Inline Markup Parsing

+264

;; ============================================================

+265

+266

;; Parse inline elements from text: *bold*, /italic/, ~code~,

+267

;; =verbatim=, _underline_, +strikethrough+, links, timestamps

+268

(define (parse-inline text)

+269

(let ((len (string-length text)))

+270

(let loop ((i 0) (start 0) (result '()))

+271

(if (>= i len)

+272

(reverse (if (> i start)

+273

(cons (substring text start i) result)

+274

result))

+275

(let ((c (string-ref text i)))

+276

(cond

+277

;; Link: [[target][desc]] or [[target]]

+278

((and (char=? c #\[)

+279

(< (+ i 1) len)

+280

(char=? (string-ref text (+ i 1)) #\[))

+281

(let ((before (if (> i start)

+282

(cons (substring text start i) result)

+283

result)))

+284

(let link-loop ((j (+ i 2)))

+285

(cond

+286

((>= j (- len 1))

+287

(loop (+ i 1) start result))

+288

((and (char=? (string-ref text j) #\])

+289

(char=? (string-ref text (+ j 1)) #\]))

+290

;; Found ]], parse link content

+291

(let* ((inner (substring text (+ i 2) j))

+292

(bracket-pos (string-index inner

+293

(lambda (c) (char=? c #\])))))

+294

(if (and bracket-pos

+295

(< (+ bracket-pos 1) (string-length inner))

+296

(char=? (string-ref inner (+ bracket-pos 1)) #\[))

+297

;; [[target][desc]]

+298

(let ((target (substring inner 0 bracket-pos))

+299

(desc (substring inner (+ bracket-pos 2)

+300

(string-length inner))))

+301

(loop (+ j 2) (+ j 2)

+302

(cons (list 'a (list '@ (list 'href target)) desc)

+303

before)))

+304

;; [[target]]

+305

(loop (+ j 2) (+ j 2)

+306

(cons (list 'a (list '@ (list 'href inner)) inner)

+307

before)))))

+308

(else (link-loop (+ j 1)))))))

+309

+310

;; Active timestamp: <2026-02-20 Fri>

+311

((and (char=? c #\<)

+312

(< (+ i 10) len)

+313

(char-numeric? (string-ref text (+ i 1))))

+314

(let ((before (if (> i start)

+315

(cons (substring text start i) result)

+316

result)))

+317

(let ts-loop ((j (+ i 1)))

+318

(cond

+319

((>= j len)

+320

(loop (+ i 1) start result))

+321

((char=? (string-ref text j) #\>)

+322

(loop (+ j 1) (+ j 1)

+323

(cons (list 'timestamp

+324

(list '@ (list 'type "active"))

+325

(substring text (+ i 1) j))

+326

before)))

+327

(else (ts-loop (+ j 1)))))))

+328

+329

;; Inactive timestamp: [2026-02-20 Fri]

+330

((and (char=? c #\[)

+331

(< (+ i 10) len)

+332

(char-numeric? (string-ref text (+ i 1))))

+333

(let ((before (if (> i start)

+334

(cons (substring text start i) result)

+335

result)))

+336

(let ts-loop ((j (+ i 1)))

+337

(cond

+338

((>= j len)

+339

(loop (+ i 1) start result))

+340

((char=? (string-ref text j) #\])

+341

(loop (+ j 1) (+ j 1)

+342

(cons (list 'timestamp

+343

(list '@ (list 'type "inactive"))

+344

(substring text (+ i 1) j))

+345

before)))

+346

(else (ts-loop (+ j 1)))))))

+347

+348

;; Markup: *bold* /italic/ ~code~ =verbatim= _underline_ +strike+

+349

((and (markup-char? c)

+350

(can-open-markup? text i len))

+351

(let ((before (if (> i start)

+352

(cons (substring text start i) result)

+353

result)))

+354

(let ((close-pos (find-closing-markup text (+ i 1) len c)))

+355

(if close-pos

+356

(let* ((inner-text (substring text (+ i 1) close-pos))

+357

(tag (markup-tag c))

+358

(content (if (or (eq? tag 'code) (eq? tag 'verbatim))

+359

(list inner-text)

+360

(parse-inline inner-text))))

+361

(loop (+ close-pos 1) (+ close-pos 1)

+362

(cons (cons tag content) before)))

+363

;; No closing marker, treat as literal

+364

(loop (+ i 1) start result)))))

+365

+366

;; Regular character

+367

(else

+368

(loop (+ i 1) start result))))))))

+369

+370

(define (markup-char? c)

+371

(or (char=? c #\*) (char=? c #\/) (char=? c #\~)

+372

(char=? c #\=) (char=? c #\_) (char=? c #\+)))

+373

+374

(define (markup-tag c)

+375

(cond

+376

((char=? c #\*) 'bold)

+377

((char=? c #\/) 'italic)

+378

((char=? c #\~) 'code)

+379

((char=? c #\=) 'verbatim)

+380

((char=? c #\_) 'underline)

+381

((char=? c #\+) 'strike)

+382

(else 'span)))

+383

+384

;; Org markup can only open when preceded by start-of-string, space, or open paren

+385

(define (can-open-markup? text i len)

+386

(and (< (+ i 1) len)

+387

(not (char=? (string-ref text (+ i 1)) #\space))

+388

(or (= i 0)

+389

(char=? (string-ref text (- i 1)) #\space)

+390

(char=? (string-ref text (- i 1)) #\()

+391

(char=? (string-ref text (- i 1)) #\newline))))

+392

+393

;; Find closing markup character (must be followed by end, space, or punct)

+394

(define (find-closing-markup text start len marker)

+395

(let loop ((j start))

+396

(cond

+397

((>= j len) #f)

+398

((char=? (string-ref text j) #\newline) #f)

+399

((and (char=? (string-ref text j) marker)

+400

(not (char=? (string-ref text (- j 1)) #\space))

+401

(or (= (+ j 1) len)

+402

(char=? (string-ref text (+ j 1)) #\space)

+403

(char=? (string-ref text (+ j 1)) #\.)

+404

(char=? (string-ref text (+ j 1)) #\,)

+405

(char=? (string-ref text (+ j 1)) #\;)

+406

(char=? (string-ref text (+ j 1)) #\:)

+407

(char=? (string-ref text (+ j 1)) #\!)

+408

(char=? (string-ref text (+ j 1)) #\?)

+409

(char=? (string-ref text (+ j 1)) #\))

+410

(char=? (string-ref text (+ j 1)) #\])

+411

(char=? (string-ref text (+ j 1)) #\newline)))

+412

j)

+413

(else (loop (+ j 1))))))

+414

+415

;; ============================================================

+416

;; List Parsing

+417

;; ============================================================

+418

+419

(define (parse-list-item-text line)

+420

(let ((trimmed (string-trim-start line)))

+421

(cond

+422

;; Unordered: - item or + item

+423

((and (>= (string-length trimmed) 2)

+424

(or (char=? (string-ref trimmed 0) #\-)

+425

(char=? (string-ref trimmed 0) #\+))

+426

(char=? (string-ref trimmed 1) #\space))

+427

(string-drop trimmed 2))

+428

;; Ordered: 1. item

+429

(else

+430

(let loop ((i 0))

+431

(cond

+432

((>= i (string-length trimmed)) trimmed)

+433

((char-numeric? (string-ref trimmed i)) (loop (+ i 1)))

+434

((and (char=? (string-ref trimmed i) #\.)

+435

(< (+ i 1) (string-length trimmed))

+436

(char=? (string-ref trimmed (+ i 1)) #\space))

+437

(string-drop trimmed (+ i 2)))

+438

(else trimmed)))))))

+439

+440

;; Parse checkbox from item text: [ ] or [x] or [X]

+441

(define (parse-checkbox text)

+442

(cond

+443

((string-starts-with? text "[ ] ")

+444

(values #f (string-drop text 4)))

+445

((or (string-starts-with? text "[x] ")

+446

(string-starts-with? text "[X] "))

+447

(values #t (string-drop text 4)))

+448

(else (values 'none text))))

+449

+450

;; ============================================================

+451

;; Block-Level Document Parser

+452

;; ============================================================

+453

+454

;;; Parse Org Mode text into an SXML document.

+455

;;;

+456

;;; Returns an `org-document` SXML element.

+457

;;;

+458

;;; ```scheme

+459

;;; (org->sxml "#+TITLE: Hello\n\n* Section 1\n\nSome text.")

+460

;;; ; => (org-document (@ (title "Hello"))

+461

;;; ; (headline (@ (level 1)) "Section 1"

+462

;;; ; (section (paragraph "Some text."))))

+463

;;; ```

+464

(define (org->sxml text)

+465

(let* ((lines (string->lines text))

+466

(result (parse-document lines)))

+467

result))

+468

+469

;;; Parse an Org Mode file into an SXML document.

+470

;;;

+471

;;; ```scheme

+472

;;; (org-file->sxml "notes.org")

+473

;;; ```

+474

(define (org-file->sxml filename)

+475

(let ((port (open-input-file filename)))

+476

(let loop ((chars '()))

+477

(let ((c (read-char port)))

+478

(if (eof-object? c)

+479

(begin

+480

(close-input-port port)

+481

(org->sxml (list->string (reverse chars))))

+482

(loop (cons c chars)))))))

+483

+484

;; Parse a full document: metadata, then top-level elements

+485

(define (parse-document lines)

+486

(let-values (((metadata rest) (parse-metadata lines)))

+487

(let ((body (parse-elements rest 0)))

+488

(if (null? metadata)

+489

(cons 'org-document body)

+490

(cons 'org-document

+491

(cons (cons '@ (map (lambda (pair)

+492

(list (car pair) (cdr pair)))

+493

metadata))

+494

body))))))

+495

+496

;; Parse metadata lines at the start

+497

(define (parse-metadata lines)

+498

(let loop ((lines lines) (metadata '()))

+499

(cond

Showing the first 500 of 726 diff lines for this file. This diff is INCOMPLETE; read the file or clone the repository for the rest.

test/test-org.sgladded

@@ -0,0 +1,314 @@

(import (sigil test)

(sigil org)

(sigil sxml)

(sigil string))

;; ============================================================

;; Metadata

;; ============================================================

+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))))

+15

+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))))

+20

+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)))))

+25

+26

;; ============================================================

+27

;; Headlines

+28

;; ============================================================

+29

+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))))

+36

+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)))))

+47

+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))))

+52

+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))))

+57

+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)))))

+62

+63

;; ============================================================

+64

;; Property Drawers

+65

;; ============================================================

+66

+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)))))

+79

+80

;; ============================================================

+81

;; Source Blocks

+82

;; ============================================================

+83

+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))))

+90

+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")))))

+97

+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

;; Integration

+289

;; ============================================================

+290

+291

(test-group "integration"

+292

(test "full document"

+293

(let ((doc (org->sxml

+294

(string-append

+295

"#+TITLE: My Document\n"

+296

"#+AUTHOR: Test User\n"

+297

"\n"

+298

"* Introduction\n"

+299

"\n"

+300

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

+301

"\n"

+302

"** Details\n"

+303

"\n"

+304

"- Item one\n"

+305

"- Item two\n"

+306

"\n"

+307

"#+BEGIN_SRC scheme\n"

+308

"(define x 42)\n"

+309

"#+END_SRC\n"))))

+310

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

+311

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

+312

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

+313

+314

(run-tests)