File: run-theme-d-program.scm.in

package info (click to toggle)
theme-d 1.4.0-1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, sid
  • size: 12,784 kB
  • sloc: lisp: 47,684; sh: 4,200; makefile: 455; ansic: 319
file content (48 lines) | stat: -rw-r--r-- 1,638 bytes parent folder | download
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
#!/usr/bin/guile-@guile_version@ \
-e __main -s
!#

;; Copyright (C) 2018 Tommi Höynälänmaa
;; Distributed under GNU Lesser General Public License version 3,
;; see file doc/LGPL-3.

(import (except (rnrs) assert map))
(import (theme-d runtime runtime-theme-d-environment))
(import (th-scheme-utilities parse-command-line))
(import (th-scheme-utilities stdutils))
(import (th-scheme-utilities hrecord))

(define gl-custom-files0 (getenv "THEME_D_CUSTOM_CODE"))

(define gl-custom-files (if (string? gl-custom-files0)
			    (split-string gl-custom-files0 #\:)
			    '()))

(for-each load-compiled gl-custom-files)

(define (__main args)
  (let* ((verbose-errors? #t)
	 (backtrace? #f)
	 (pretty-backtrace? #f)
	 (argd1 (make-hrecord <argument-descriptor> "no-verbose-errors" #f
			      (lambda () (set! verbose-errors? #f))))
	 (argd2 (make-hrecord <argument-descriptor> "backtrace" #f
			      (lambda () (set! backtrace? #t))))
	 (argd3 (make-hrecord <argument-descriptor> "pretty-backtrace" #f
			      (lambda () (set! pretty-backtrace? #t))))
	 (args-without-cmd (cdr args))
	 (arg-descs (list argd1 argd2 argd3))
	 (proper-args '())
	 (handle-proper-args (lambda (proper-args1)
			       (set! proper-args proper-args1))))
    (parse-command-line args-without-cmd arg-descs handle-proper-args)
    (theme-set-command-line! proper-args)
    (guard (exc (else (my-error-exit exc)))
	   (load-compiled (car proper-args)))
    (if (not gl-script?)
	(begin
	  (set-verbose-errors! verbose-errors?)
	  (set-backtrace! backtrace?)
	  (set-pretty-backtrace! pretty-backtrace?)
	  (set-rte-exception-info! #t)
	  (main proper-args)))))