1 ; file: symcache.scm
 2 ; type: lepton-schematic Guile script
 3 ; copyright (c) 2020-2021 dmn <graahnul.grom@gmail.com>
 4 ; license: GPLv2+
 5 ;
 6 ; Saves all symbols used in schematic(s) to "symcache"
 7 ; subdir in current schematic's directory.
 8 ;
 9 ; Usage:
10 ; Type in the ":" prompt or add this to your gschemrc file:
11 ;   ( primitive-load "/path/to/symcache.scm" )
12 ; Type ( symcache ) in the ":" prompt to save current schematic's
13 ; symbols to "symcache" directory or ( symcache-all ) to save
14 ; symbols from all opened schematics.
15 ;
16 
17 
18 
19 ( use-modules ( srfi srfi-1 ) ) ; delete-duplicates()
20 ( use-modules ( lepton page ) )
21 ( use-modules ( lepton object ) )
22 ( use-modules ( schematic window ) )
23 
24 ( define outdir_name "symcache" )
25 
26 
27 
28 ( define ( geom-off )
29     ( use-modules ( lepton config ) )
30     ( set-config!
31         ( path-config-context (getcwd) )
32         "load-from-path"
33         "restore-window-geometry"
34         "false"
35     )
36 )
37 
38 ( define ( symcache-all )
39     ( for-each symcache-impl (active-pages) )
40 )
41 
42 ( define ( symcache )
43     ( symcache-impl (active-page) )
44 )
45 
46 ( define ( symcache-impl page )
47 ( let*
48     (
49     ( cont    ( page-contents page ) )
50     ( comps   ( filter component? cont ) )
51     ( fpaths0 ( map component-filename comps ) )
52     ( fpaths  ( delete-duplicates fpaths0 ) )
53     ( outdir  outdir_name )
54     )
55 
56     ( define ( outpath srcpath )
57         ( format #f "~a/~a" outdir (basename srcpath) )
58     )
59 
60     ( define ( do_copy srcpath )
61         ( if ( string-ci=? srcpath (outpath srcpath) )
62             ( format #t "symcache.scm: EE: src == dest => NOOP~%" ) ; if
63             ( copy-file srcpath (outpath srcpath) )                 ; else
64         )
65     )
66 
67 
68     ( format #t "fpaths: count: [ ~a ]~%" (length fpaths) )
69     ( format #t "fpaths:~%~{  ~a~%~}~%" fpaths )
70 
71     ( set! outdir ( format #f "~a/~a" (getcwd) outdir_name ) )
72     ( format #t "outdir: [~a]~%" outdir )
73 
74     ( false-if-exception ( mkdir outdir ) )
75 
76     ( for-each
77     ( lambda( fpath )
78         ( if fpath
79             ( do_copy fpath )                                      ; if
80             ( format #t "symcache.scm: EE: !fpath: [~a]~%" fpath ) ; else
81         )
82     )
83       fpaths
84     )
85 
86 ) ; let
87 ) ;
88