;; -*-theme-d-*-

;; Copyright (C) 2025 Tommi Höynälänmaa

;; This file is part of Theme-D-Intr.

;; You can redistribute and/or modify this file under the terms of the
;; GNU Lesser General Public License as published by the Free Software
;; Foundation, either version 3 of the License, or (at your option) any
;; later version.

;; This file is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.

;; You should have received a copy of the GNU Lesser General Public License
;; along with this program. If not, see https://www.gnu.org/licenses/.

(define-body (intr-gtk4-examples calc2 utils)


  (import (standard-library list-utilities)
          (standard-library console-io))


  (define-mutable gl-l-s-debug-cat (:uniform-list <symbol>)
    ;; '(debug2))
    '())


  (define-simple-method dwln (((s-cat <symbol>) (l (rest <object>))) <none> nonpure)
    (if (member? s-cat gl-l-s-debug-cat)
        (begin
         (for-each1 (lambda (((x <object>)) <none> nonpure)
                      (console-display x))
                    l)
         (console-newline)
         (flush-all-ports))))
  

  (add-method dirname
    (prim-proc dirname (<string>) <string> pure))


  (add-method get-load-compiled-path
    (prim-proc get-load-compiled-path () (:uniform-list <string>) pure))


  (add-method set-load-compiled-path!
    (prim-proc set-load-compiled-path! ((:uniform-list <string>)) <none> nonpure))


;;   (add-method remove-stat
;;     (prim-proc remove-stat (<object>) <object> pure))


;;   (add-method file-system-tree
;;     (prim-proc file-system-tree (<string>) <object> nonpure))


  (add-method get-plain-file-tree
    (prim-proc get-plain-file-tree (<string>) <object> nonpure))


  (define-simple-proc raise2 (((s-kind <rte-exception-kind>)
                               (al-info (rest (:pair <symbol> <object>))))
                              <none> (pure never-returns))
    (raise (make-rte-exception s-kind al-info)))


  (add-method current-filename
    (prim-proc my-current-filename () (:alt-maybe <string>) pure))


  (define-simple-method current-dirname
      (() (:alt-maybe <string>) pure)
    (match-type (current-filename)
      ((<boolean>) #f)
      ((str1 <string>) (dirname str1)))))



