summaryrefslogtreecommitdiff
path: root/src/bigloo/parseargs.scm
blob: 4ce58c4d5cb5d051eae1ce2763330a899e5e8059 (plain)
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
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
;*=====================================================================*/
;*    serrano/prgm/project/skribe/src/bigloo/parseargs.scm             */
;*    -------------------------------------------------------------    */
;*    Author      :  Manuel Serrano                                    */
;*    Creation    :  Tue Jul 22 16:52:53 2003                          */
;*    Last change :  Wed Nov 10 10:57:40 2004 (serrano)                */
;*    Copyright   :  2003-04 Manuel Serrano                            */
;*    -------------------------------------------------------------    */
;*    Argument parsing                                                 */
;*=====================================================================*/

;*---------------------------------------------------------------------*/
;*    The module                                                       */
;*---------------------------------------------------------------------*/
(module skribe_parse-args
   
   (include "debug.sch")

   (import  skribe_configure
	    skribe_param
	    skribe_read
	    skribe_types
	    skribe_eval)
   
   (export  (parse-env-variables)
	    (parse-args ::pair)
	    (load-rc)))

;*---------------------------------------------------------------------*/
;*    parse-env-variables ...                                          */
;*---------------------------------------------------------------------*/
(define (parse-env-variables)
   (let ((e (getenv "SKRIBEPATH")))
      (if (string? e)
	  (skribe-path-set! (append (unix-path->list e) (skribe-path))))))

;*---------------------------------------------------------------------*/
;*    parse-args ...                                                   */
;*---------------------------------------------------------------------*/
(define (parse-args args)
   (define (usage args-parse-usage)
      (print "usage: skribe [options] [input]")
      (newline)
      (args-parse-usage #f)
      (newline)
      (print "Rc file:")
      (newline)
      (print "   *skribe-rc* (searched in \".\" then $HOME)")
      (newline)
      (print "Target formats:")
      (for-each (lambda (f) (print "   - " (car f))) *skribe-auto-mode-alist*)
      (newline)
      (print "Shell Variables:")
      (newline)
      (for-each (lambda (var)
		   (print "   - " (car var) " " (cdr var)))
		'(("SKRIBEPATH" . "Skribe input path (all files)"))))
   (define (version)
      (print "skribe v" (skribe-release)))
   (define (query)
      (version)
      (newline)
      (for-each (lambda (x)
		   (let ((s (keyword->string (car x))))
		      (printf "  ~a: ~a\n"
			      (substring s 1 (string-length s))
			      (cadr x))))
		(skribe-configure)))
   (let ((np  '())
	 (engine #f))
      (args-parse (cdr args)
	 ((("-h" "--help") (help "This message"))
	  (usage args-parse-usage)
	  (exit 0))
	 (("--options" (help "Display the skribe options and exit"))
	  (args-parse-usage #t)
	  (exit 0))
	 (("--version" (help "The version of Skribe"))
	  (version)
	  (exit 0))
	 ((("-q" "--query") (help "Display informations about the Skribe configuration"))
	  (query)
	  (exit 0))
	 ((("-c" "--custom") ?key=val (synopsis "Preset custom value"))
	  (let ((l (string-length key=val)))
	     (let loop ((i 0))
		(cond
		   ((= i l)
		    (skribe-error 'skribe "Illegal option" key=val))
		   ((char=? (string-ref key=val i) #\=)
		    (let ((key (substring key=val 0 i))
			  (val (substring key=val (+ i 1) l)))
		       (set! *skribe-precustom*
			     (cons (cons (string->symbol key) val)
				   *skribe-precustom*))))
		   (else
		    (loop (+ i 1)))))))
	 (("-v?level" (help "Increase or set verbosity level (-v0 for crystal silence)"))
	  (if (string=? level "")
	      (set! *skribe-verbose* (+fx 1 *skribe-verbose*))
	      (set! *skribe-verbose* (string->integer level))))
	 (("-w?level" (help "Increase or set warning level (-w0 for crystal silence)"))
	  (if (string=? level "")
	      (set! *skribe-warning* (+fx 1 *skribe-warning*))
	      (set! *skribe-warning* (string->integer level))))
	 (("-g?level" (help "Increase or set debug level"))
	  (if (string=? level "")
	      (set! *skribe-debug* (+fx 1 *skribe-debug*))
	      (let ((l (string->integer level)))
		 (if (= l 0)
		     (begin
			(set! *skribe-debug* 1)
			(set! *skribe-debug-symbols*
			      (cons (string->symbol level)
				    *skribe-debug-symbols*)))
		     (set! *skribe-debug* l)))))
	 (("--no-color" (help "Disable coloring for debug"))
	  (set! *skribe-debug-color* #f))
	 ((("-t" "--target") ?e (help "The output target format"))
	  (set! engine (string->symbol e)))
	 (("-I" ?path (help "Add <path> to skribe path"))
	  (set! np (cons path np)))
	 (("-B" ?path (help "Add <path> to skribe bibliography path"))
	  (skribe-bib-path-set! (cons path (skribe-bib-path))))
	 (("-S" ?path (help "Add <path> to skribe source path"))
	  (skribe-source-path-set! (cons path (skribe-source-path))))
	 (("-P" ?path (help "Add <path> to skribe image path"))
	  (skribe-image-path-set! (cons path (skribe-image-path))))
	 ((("-C" "--split-chapter") ?chapter (help "Emit chapter's sections in separate files"))
	  (set! *skribe-chapter-split* (cons chapter *skribe-chapter-split*)))
	 (("--eval" ?expr (help "Evaluate expression"))
	  (with-input-from-string expr
	     (lambda ()
		(eval (skribe-read)))))
	 (("--no-init-file" (help "Dont load rc Skribe file"))
	  (set! *load-rc* #f))
	 ((("-p" "--preload") ?file (help "Preload file"))
	  (set! *skribe-preload* (cons file *skribe-preload*)))
	 ((("-u" "--use-variant") ?variant (help "use <variant> output format"))
	  (set! *skribe-variants* (cons variant *skribe-variants*)))
	 ((("-o" "--output") ?o (help "The output target name"))
	  (set! *skribe-dest* o)
	  (let* ((s (suffix o))
		 (c (assoc s *skribe-auto-mode-alist*)))
	     (if (and (pair? c) (symbol? (cdr c)))
		 (set! *skribe-engine* (cdr c)))))
	 ((("-b" "--base") ?base (help "The base prefix to be removed from hyperlinks"))
	  (set! *skribe-ref-base* base))
	 ;; skribe rc directory
	 ((("-d" "--rc-dir") ?dir (synopsis "Set the skribe RC directory"))
	  (set! *skribe-rc-directory* dir))
	 (else
	  (set! *skribe-src* (cons else *skribe-src*))))
      ;; we have to configure according to the environment variables
      (if engine (set! *skribe-engine* engine))
      (set! *skribe-src* (reverse! *skribe-src*))
      (skribe-path-set! (append (build-path-from-shell-variable "SKRIBEPATH")
				(reverse! np)
				(skribe-path)))))

;*---------------------------------------------------------------------*/
;*    build-path-from-shell-variable ...                               */
;*---------------------------------------------------------------------*/
(define (build-path-from-shell-variable var)
   (let ((val (getenv var)))
      (if (string? val)
	  (string-case val
	     ((+ (out #\:))
	      (let* ((str (the-string))
		     (res (ignore)))
		 (cons str res)))
	     (#\:
	      (ignore))
	     (else
	      '()))
	  '())))

;*---------------------------------------------------------------------*/
;*    load-rc ...                                                      */
;*---------------------------------------------------------------------*/
(define (load-rc)
   (if *load-rc*
       (let ((file (make-file-name *skribe-rc-directory* *skribe-rc-file*)))
	  (if (and (string? file) (file-exists? file))
	      (loadq file)))))