1#!/usr/bin/env sh
2exec @GUILE@ "$0" "$@"
3!#
4
5;;
6;; Lepton EDA
7;; lepton-embed - schematic components and pictures embedding utility
8;; Copyright (C) 2019 dmn <graahnul.grom@gmail.com>
9;; Copyright (C) 2019-2021 Lepton EDA Contributors
10;; License: GPLv2+. See the COPYING file
11;;
12
13(eval-when (expand load eval)
14  (unless (getenv "LIBLEPTON")
15    (add-to-load-path "@LEPTON_SCHEME_MODULE_DIRECTORY@")
16    (set! %load-compiled-path (cons "@ccachedir@" %load-compiled-path))))
17
18(use-modules (ice-9 format)
19             (ice-9 getopt-long)
20             (lepton ffi))
21
22;; Initialize liblepton library.
23(liblepton_init)
24(unless (getenv "LEPTON_INHIBIT_RC_FILES")
25  (register-data-dirs))
26(edascm_init)
27
28( primitive-eval '(use-modules (lepton core toplevel)) )
29( primitive-eval '(use-modules (lepton object)) )
30( primitive-eval '(use-modules (lepton page)) )
31( primitive-eval '(use-modules (lepton rc)) )
32( primitive-eval '(use-modules (lepton version)) )
33
34
35
36; command line options:
37;
38( define cmd-line-args-spec
39( list
40  ( list ; --embed (-e)
41    'embed
42    ( list 'single-char #\e )
43    ( list 'value        #f )
44  )
45  ( list ; --unembed (-u)
46    'unembed
47    ( list 'single-char #\u )
48    ( list 'value        #f )
49  )
50  ( list ; --pictures (-p)
51    'pictures
52    ( list 'single-char #\p )
53    ( list 'value        #f )
54  )
55  ( list ; --components (-c)
56    'components
57    ( list 'single-char #\c )
58    ( list 'value        #f )
59  )
60  ( list ; --suffix (-x)
61    'suffix
62    ( list 'single-char #\x )
63    ( list 'value        #t )
64  )
65  ( list ; --help (-h)
66    'help
67    ( list 'single-char #\h )
68    ( list 'value        #f )
69  )
70  ( list ; --version (-V)
71    'version
72    ( list 'single-char #\V )
73    ( list 'value        #f )
74  )
75)
76) ; cmd-line-args-spec
77
78
79
80( define ( usage exit-code )
81  ( format #t "~
82Usage: lepton-embed -e | -u [OPTIONS] FILE ...
83
84Lepton EDA schematic components and pictures embedding/unembedding utility.
85
86Options:
87  -e, --embed          Embed: without -p or -c, all components and pictures
88  -u, --unembed        Unembed: without -p or -c, all components and pictures
89  -p, --pictures       Process pictures only
90  -c, --components     Process components only
91  -x, --suffix SUFFIX  Keep input files intact, save to FILE.SUFFIX
92  -h, --help           Show usage information
93  -V, --version        Show version information
94
95Report bugs at <~a>
96Lepton EDA homepage: <~a>
97"
98    ( lepton-version 'bugs )
99    ( lepton-version 'url )
100  )
101
102  ( primitive-exit exit-code )
103)
104
105
106
107( define ( version )
108  ( display-lepton-version #:print-name #t #:copyright #t )
109  ( primitive-exit 0 )
110)
111
112
113
114( define ( page-open file )
115  ( catch #t
116  ( lambda()
117    ; return:
118    ( file->page file )
119  )
120  ( lambda( ex . args )
121    ( format (current-error-port)
122              "Cannot open file [~a]:~%  '~a: ~a~%"
123              file ex args )
124    ; return:
125    #f
126  )
127  ) ; catch
128) ; page-open()
129
130
131
132( define ( page-save page suffix )
133
134  ( define ( mk-out-file-name file )
135    ; return:
136    ( if ( string-null? suffix )
137      file                         ; if
138      ( format #f "~a~a~a.~a"      ; else
139        ( dirname file )
140        file-name-separator-string
141        ( basename file )
142        suffix
143      )
144    )
145  ) ; mk-out-file-name()
146
147( let*
148  (
149  ( file ( page-filename page ) )
150  ( out  ( mk-out-file-name file ) )
151  )
152
153  ( catch #t
154  ( lambda()
155    ( with-output-to-file out
156      ( lambda()
157        ( format #t "~a" (page->string page) )
158        ( format (current-error-port) "Saved: [~a]~%" out )
159        ; return:
160        #t
161      )
162    )
163  )
164  ( lambda( ex . args )
165    ( format (current-error-port)
166              "Cannot save file [~a]:~%  '~a: ~a~%"
167              out ex args )
168    ; return:
169    #f
170  )
171  ) ; catch
172
173) ; let
174) ; page-save()
175
176
177
178( define ( embeddable? obj )
179  ; return:
180  ( or
181    ( component? obj )
182    ( picture?   obj )
183  )
184)
185
186
187
188( define ( do-embed page embed chk-embeddable )
189
190  ( for-each
191  ( lambda( comp )
192      ( set-object-embedded! comp embed )
193  )
194  ( filter chk-embeddable (page-contents page) )
195  )
196
197) ; do-embed()
198
199
200
201( define ( process-file file embed chk-embeddable suffix )
202( let
203  (
204  ( page ( page-open file ) )
205  )
206
207  ( when page
208    ( do-embed page embed chk-embeddable )
209    ( if ( page-dirty? page )
210      ( page-save page suffix )
211    )
212  )
213
214) ; let
215) ; process-file()
216
217
218
219( define ( main )
220( let*
221  (
222  ( cmd-line-args  (getopt-long (program-arguments) cmd-line-args-spec) )
223  ( files          (option-ref cmd-line-args '()        '()) )
224  ( arg-embed      (option-ref cmd-line-args 'embed      #f) )
225  ( arg-unembed    (option-ref cmd-line-args 'unembed    #f) )
226  ( arg-pics       (option-ref cmd-line-args 'pictures   #f) )
227  ( arg-comps      (option-ref cmd-line-args 'components #f) )
228  ( suffix         (option-ref cmd-line-args 'suffix     "") )
229  ( chk-embeddable embeddable? )
230  )
231
232  ( if ( option-ref cmd-line-args 'help #f )
233    ( usage 0 )
234  )
235  ( if ( option-ref cmd-line-args 'version #f )
236    ( version )
237  )
238
239  ( if ( and arg-embed arg-unembed )
240    ( usage 1 )
241  )
242  ( if ( and (not arg-embed) (not arg-unembed) )
243    ( usage 2 )
244  )
245
246  ( if ( null? files )
247    ( usage 3 )
248  )
249
250  ( if arg-pics
251    ( set! chk-embeddable picture? )
252  )
253  ( if arg-comps
254    ( set! chk-embeddable component? )
255  )
256  ( if ( and arg-pics arg-comps )
257    ( set! chk-embeddable embeddable? )
258  )
259
260
261  (parse-rc "lepton-embed" "gafrc")
262
263  ( for-each
264  ( lambda( file )
265    ( process-file file arg-embed chk-embeddable suffix )
266  )
267    files
268  )
269
270) ; let
271) ; main()
272
273
274
275
276( %with-toplevel
277  ( %make-toplevel )
278  ( lambda()
279    ( main )
280  )
281)
282