path: root/sundry/editor-syntax-etc/emacs/sisu-spine-ts-mode.el

;;; sisu-spine-ts-mode.el --- Tree-sitter major mode for SiSU spine markup -*- lexical-binding: t; -*-

;; Copyright (C) 2026  Free Software Foundation, Inc.

;; Author: Ralph Amissah <ralph.amissah@gmail.com>
;; Maintainer: Ralph Amissah <ralph.amissah@gmail.com>
;; Keywords: text, syntax, processes, tools
;; Version:   1.0.0
;; URL: https://git.sisudoc.org/projects/sisudoc-spine/tree/sundry/editor-syntax-etc/emacs/sisu-spine-ts-mode.el
;;      https://sisudoc.org/

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.

;;; Commentary:

;; Tree-sitter-backed major mode for SiSU spine markup (.sst / .ssm /
;; .ssi).  Sibling to `sisu-spine-mode' (regex / font-lock); requires
;; Emacs 29 or newer with `treesit' built in and the tree-sitter-sisu
;; parser installed.
;;
;; To install the parser inside Emacs:
;;
;;   M-x sisu-spine-ts-install-grammar RET
;;
;; or, equivalently:
;;
;;   (add-to-list 'treesit-language-source-alist
;;     '(sisu "https://git.sisudoc.org/projects"
;;            :source-dir "tree-sitter-sisu/src"))
;;   M-x treesit-install-language-grammar RET sisu RET
;;
;; The mode is auto-enabled for .sst / .ssm / .ssi files when the parser
;; is available.  When it is not, `sisu-spine-mode' (the regex variant)
;; remains available as a fallback.

;;; Code:

(require 'treesit nil t)

(defgroup sisu-spine-ts nil
  "Tree-sitter mode for SiSU spine markup."
  :group 'text
  :prefix "sisu-spine-ts-")

;; ---------------------------------------------------------------------
;; Faces (mirror the structural categories the highlights.scm assigns)
;; ---------------------------------------------------------------------

(defface sisu-spine-ts-heading-1-face
  '((t (:inherit outline-1 :weight bold)))
  "Face for :A~ headings."
  :group 'sisu-spine-ts)

(defface sisu-spine-ts-heading-2-face
  '((t (:inherit outline-2 :weight bold)))
  "Face for :B~ headings."
  :group 'sisu-spine-ts)

(defface sisu-spine-ts-heading-3-face
  '((t (:inherit outline-3 :weight bold)))
  "Face for :C~ / :D~ headings."
  :group 'sisu-spine-ts)

(defface sisu-spine-ts-heading-segment-face
  '((t (:inherit outline-4)))
  "Face for 1~ / 2~ / 3~ segment headings."
  :group 'sisu-spine-ts)

(defface sisu-spine-ts-block-delimiter-face
  '((t (:inherit font-lock-keyword-face)))
  "Face for block opening/closing delimiters."
  :group 'sisu-spine-ts)

(defface sisu-spine-ts-raw-content-face
  '((t (:inherit font-lock-string-face)))
  "Face for raw block content (code, table, etc.)."
  :group 'sisu-spine-ts)

(defface sisu-spine-ts-footnote-face
  '((t (:inherit font-lock-doc-face)))
  "Face for footnote and editor-note bodies."
  :group 'sisu-spine-ts)

(defface sisu-spine-ts-link-face
  '((t (:inherit link)))
  "Face for link text and target URLs."
  :group 'sisu-spine-ts)

(defface sisu-spine-ts-book-index-face
  '((t (:inherit font-lock-preprocessor-face)))
  "Face for book-index entries (={...})."
  :group 'sisu-spine-ts)

(defface sisu-spine-ts-marker-face
  '((t (:inherit font-lock-builtin-face)))
  "Face for inline-formatting delimiters and other punctuation markers."
  :group 'sisu-spine-ts)

;; ---------------------------------------------------------------------
;; Font-lock rules
;; ---------------------------------------------------------------------

(defvar sisu-spine-ts--font-lock-settings
  (when (fboundp 'treesit-font-lock-rules)
    (treesit-font-lock-rules
     :language 'sisu
     :feature 'comment
     '((version_comment) @font-lock-doc-face
       (header_comment)  @font-lock-comment-face
       (body_comment)    @font-lock-comment-face)

     :language 'sisu
     :feature 'header
     '((header_field key: (header_key)   @font-lock-keyword-face)
       (header_field value: (header_value) @font-lock-string-face)
       (header_continuation) @font-lock-string-face)

     :language 'sisu
     :feature 'heading
     '(((heading_part marker: (part_marker) @m
                       content: (heading_content) @sisu-spine-ts-heading-1-face)
        (:match "^:A~$" @m))
       ((heading_part marker: (part_marker) @m
                       content: (heading_content) @sisu-spine-ts-heading-2-face)
        (:match "^:B~$" @m))
       ((heading_part marker: (part_marker) @m
                       content: (heading_content) @sisu-spine-ts-heading-3-face)
        (:match "^:[CD]~$" @m))
       (heading_part marker: (part_marker) @sisu-spine-ts-marker-face)
       (heading_segment marker: (segment_marker) @sisu-spine-ts-marker-face
                        content: (heading_content) @sisu-spine-ts-heading-segment-face)
       (segment_name) @font-lock-function-name-face
       (suppress_marker) @sisu-spine-ts-marker-face)

     :language 'sisu
     :feature 'block
     '((block_open)  @sisu-spine-ts-block-delimiter-face
       (block_close) @sisu-spine-ts-block-delimiter-face
       (raw_content) @sisu-spine-ts-raw-content-face
       (table_spec)  @sisu-spine-ts-block-delimiter-face)

     :language 'sisu
     :feature 'inline
     '((emphasis)         @italic
       (bold)             @bold
       (italic)           @italic
       (underline)        @underline
       (citation_mark)    @font-lock-string-face
       (superscript)      @font-lock-type-face
       (subscript)        @font-lock-type-face
       (inserted)         @underline
       (strikethrough)    @shadow
       (monospace_inline) @font-lock-constant-face)

     :language 'sisu
     :feature 'note
     '((footnote)         @sisu-spine-ts-footnote-face
       (footnote_marker)  @sisu-spine-ts-marker-face
       (editor_note)      @sisu-spine-ts-footnote-face)

     :language 'sisu
     :feature 'link
     '((link text: (link_text) @sisu-spine-ts-link-face)
       (link target: (url) @sisu-spine-ts-link-face)
       (link target: (anchor_ref) @sisu-spine-ts-link-face)
       (link target: (collection_path) @sisu-spine-ts-link-face)
       (image spec: (image_spec) @sisu-spine-ts-link-face)
       (auto_footnote_marker) @sisu-spine-ts-marker-face
       (inline_anchor) @font-lock-function-name-face
       (anchor_name)   @font-lock-function-name-face)

     :language 'sisu
     :feature 'index
     '((book_index)    @sisu-spine-ts-book-index-face
       (index_content) @font-lock-string-face)

     :language 'sisu
     :feature 'misc
     '((paragraph_prefix) @sisu-spine-ts-marker-face
       (page_break)       @sisu-spine-ts-marker-face
       (horizontal_rule)  @sisu-spine-ts-marker-face
       (line_break)       @sisu-spine-ts-marker-face
       (ocn_suppress)        @font-lock-comment-face
       (ocn_suppress_open)   @font-lock-comment-face
       (ocn_suppress_close)  @font-lock-comment-face
       (composite_include) @font-lock-preprocessor-face
       (include_path)      @font-lock-string-face)))
  "Tree-sitter font-lock rules for `sisu-spine-ts-mode'.")

;; ---------------------------------------------------------------------
;; Imenu / navigation / things
;; ---------------------------------------------------------------------

(defvar sisu-spine-ts--imenu-settings
  '(("Part headings"
     "\\`heading_part\\'"
     nil
     sisu-spine-ts--imenu-name-part)
    ("Segment headings"
     "\\`heading_segment\\'"
     nil
     sisu-spine-ts--imenu-name-segment))
  "`treesit-simple-imenu-settings' for `sisu-spine-ts-mode'.")

(defun sisu-spine-ts--imenu-name-part (node)
  "Return display name for a heading_part NODE."
  (let ((c (treesit-node-child-by-field-name node "content"))
        (m (treesit-node-child-by-field-name node "marker")))
    (concat (and m (treesit-node-text m t)) " "
            (and c (treesit-node-text c t)))))

(defun sisu-spine-ts--imenu-name-segment (node)
  "Return display name for a heading_segment NODE."
  (let ((c (treesit-node-child-by-field-name node "content"))
        (m (treesit-node-child-by-field-name node "marker")))
    (concat (and m (treesit-node-text m t)) " "
            (and c (treesit-node-text c t)))))

(defvar sisu-spine-ts--thing-settings
  '((sisu
     (defun "\\`heading_\\(part\\|segment\\)\\'")
     (sentence "\\`paragraph\\'")
     (text "\\`\\(text\\|raw_content\\|heading_content\\)\\'")))
  "`treesit-thing-settings' for `sisu-spine-ts-mode'.")

;; ---------------------------------------------------------------------
;; Grammar install helper
;; ---------------------------------------------------------------------

;;;###autoload
(defun sisu-spine-ts-install-grammar ()
  "Register and install the tree-sitter-sisu grammar.
Convenience wrapper around `treesit-install-language-grammar' with the
upstream URL and source directory pre-filled."
  (interactive)
  (unless (boundp 'treesit-language-source-alist)
    (user-error "treesit not available; Emacs 29+ required"))
  (add-to-list 'treesit-language-source-alist
               '(sisu "https://git.sisudoc.org/projects"
                      :source-dir "tree-sitter-sisu/src"))
  (treesit-install-language-grammar 'sisu))

;; ---------------------------------------------------------------------
;; Major mode
;; ---------------------------------------------------------------------

;;;###autoload
(define-derived-mode sisu-spine-ts-mode text-mode "SiSU-Spine[ts]"
  "Major mode for SiSU spine markup, backed by tree-sitter."
  (unless (and (fboundp 'treesit-ready-p) (treesit-ready-p 'sisu))
    (user-error
     "tree-sitter-sisu parser not installed; run M-x sisu-spine-ts-install-grammar"))
  (treesit-parser-create 'sisu)

  ;; Comments
  (setq-local comment-start "% "
              comment-end   ""
              comment-start-skip "%[ \t]+")

  ;; Font-lock
  (setq-local treesit-font-lock-settings sisu-spine-ts--font-lock-settings)
  (setq-local treesit-font-lock-feature-list
              '((comment header heading)
                (block inline note link index)
                (misc)
                ()))

  ;; Imenu / navigation
  (setq-local treesit-simple-imenu-settings sisu-spine-ts--imenu-settings)
  (setq-local treesit-thing-settings sisu-spine-ts--thing-settings)
  (setq-local treesit-defun-type-regexp "\\`heading_\\(part\\|segment\\)\\'")
  (setq-local treesit-defun-name-function
              (lambda (node)
                (let ((c (treesit-node-child-by-field-name node "content")))
                  (and c (treesit-node-text c t)))))

  (treesit-major-mode-setup))

;;;###autoload
(when (fboundp 'treesit-ready-p)
  (dolist (ext '("\\.sst\\'" "\\.ssm\\'" "\\.ssi\\'"))
    ;; Prefer the ts mode iff the parser is installed; otherwise fall
    ;; back to `sisu-spine-mode'.
    (add-to-list 'auto-mode-alist
                 (cons ext
                       (lambda ()
                         (if (treesit-ready-p 'sisu t)
                             (sisu-spine-ts-mode)
                           (sisu-spine-mode)))))))

(provide 'sisu-spine-ts-mode)

;;; sisu-spine-ts-mode.el ends here