1 ; file: quick.scm
  2 ; type: lepton-schematic Guile script
  3 ; copyright (c) 2020-2023 dmn <graahnul.grom@ya.ru>
  4 ; license: GPLv2+
  5 ;
  6 ; Quickly access schematic objects from the ":" prompt.
  7 ; For the list of functions, see the Q() function below.
  8 ;
  9 ; Usage:
 10 ; Add the following to your gschemrc file:
 11 ;   ( primitive-load "/path/to/quick.scm" )
 12 ;
 13 
 14 
 15 
 16 ( use-modules ( srfi srfi-1 ) )
 17 ( use-modules ( ice-9 format ) )
 18 ( use-modules ( lepton log ) )
 19 ( use-modules ( lepton config ) )
 20 ( use-modules ( lepton page   ) )
 21 ( use-modules ( lepton object ) )
 22 ( use-modules ( lepton attrib ) )
 23 ( use-modules ( schematic selection ) )
 24 ( use-modules ( schematic window ) )
 25 
 26 
 27 
 28 ( define ( Q ) ; display list of funcs in this file
 29     ( define (oo str) (log! 'message str) )
 30     ( oo "" )
 31     ( oo "Functions defined in [quick.scm]:" )
 32     ( oo " - prn(str):        print str to the log" )
 33     ( oo " - pstr():          page contents as string" )
 34     ( oo " - sobjs():         list of selected objects" )
 35     ( oo " - sobj():          first selected object (#f if none)" )
 36     ( oo " - scomps():        list of selected componenets" )
 37     ( oo " - scomp():         first selected component (#f if none)" )
 38     ( oo " - cfgget(grp, key):      get cfg key" )
 39     ( oo " - cfgset(grp, key, val): set cfg key in local ctx w/o save" )
 40     ( oo " - next[c,n,a,t](): select next comp, net, attr, text; ~
 41                               keys: q [c,n,a,t]" )
 42     ( &options-show-log-window )
 43 )
 44 
 45 
 46 
 47 ( define ( nextobj pred )
 48     ( define ( select-obj comp )
 49         ( select-object! comp )
 50         ( for-each select-object! (object-attribs comp) )
 51     )
 52 
 53     ( define ( next-in-list val lst )
 54         ( if ( eq? val (last lst) )
 55             ( first lst )             ; if
 56             ( cadr (member val lst) ) ; else (cadr: car of cdr)
 57         )
 58     )
 59 
 60     ( define p ( active-page ) )
 61     ( define s ( page-selection p ) )
 62     ( define soo ( filter pred s ) )
 63     ( define so ( if (null? soo) #f (first soo) ) )
 64     ( define oo ( filter pred (page-contents p) ) )
 65 
 66     ( &edit-deselect )
 67     ( if so
 68         ( select-obj (next-in-list so oo) )
 69         ( if ( null? oo )
 70             ( prn (format #f "quick.scm: no objs, pred: [~s]" pred) )
 71             ( select-obj (first oo) )
 72         )
 73     )
 74 ) ; nextobj()
 75 
 76 ( define ( nextc ) ( nextobj component? ))
 77 ( define ( nextn ) ( nextobj net? ))
 78 ( define ( nexta )
 79     ( define ( attr? obj )
 80         ( and (attribute? obj) (text-visible? obj) )
 81     )
 82     ( nextobj attr? )
 83 )
 84 ( define ( nextt )
 85     ( define ( txt? obj )
 86         ( and (text? obj) (not (attribute? obj)) (text-visible? obj) )
 87     )
 88     ( nextobj txt? )
 89 )
 90 
 91 ( global-set-key "q c" 'nextc )
 92 ( global-set-key "q n" 'nextn )
 93 ( global-set-key "q a" 'nexta )
 94 ( global-set-key "q t" 'nextt )
 95 
 96 
 97 
 98 ( define ( prn str )
 99     ( log! 'message str )
100 )
101 
102 
103 ( define ( pstr ) ; page contents as string
104     ; return:
105     ( page->string (active-page) )
106 )
107 
108 
109 ( define ( sobjs ) ; list of selected objects
110     ; return:
111     ( page-selection (active-page) )
112 )
113 
114 
115 ( define ( sobj ) ; first selected object (#f if none selected)
116     ; return:
117     ( if ( null? (sobjs) )
118         #f             ; if
119         ( car (sobjs) ) ; else
120     )
121 )
122 
123 
124 ( define ( scomps ) ; list of selected componenets
125     ; return:
126     ( filter component? (sobjs) )
127 )
128 
129 
130 ( define ( scomp ) ; first selected component (#f if none selected)
131     ; return:
132     ( if ( null? (scomps) )
133         #f               ; if
134         ( car (scomps) ) ; else
135     )
136 )
137 
138 
139 
140 ( define ( cfgget grp key ) ; get cfg key
141     ( catch #t
142         ( lambda()
143             ( config-string (path-config-context (getcwd)) grp key )
144         )
145         ( lambda( e . aa )
146             ( log! 'warning "!cfgget(~s,~s): '~a~%  ~a" grp key e aa )
147         )
148     )
149 )
150 
151 ( define ( cfgset grp key val ) ; set cfg key in local context w/o save
152     ( catch #t
153         ( lambda()
154             ( set-config! (path-config-context (getcwd)) grp key val )
155         )
156         ( lambda( e . aa )
157             ( log! 'warning "!cfgset(~s,~s,~a): '~a~%  ~a" grp key val e aa )
158         )
159     )
160 )
161