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