//Translations of this page are also available in the following languages:// [[guile_scripting.ru|Русский]].

===== Guile scripting =====

gEDA/gaf uses [[http://www.gnu.org/s/guile/|Guile Scheme]] to provide Scheme scripting capabilities, and all of the features of Guile are available to use.  The //Guile Reference Manual// is available as an Info manual (''[[info://guile|info guile]]'' on most systems), or [[http://www.gnu.org/software/guile/docs/docs.html|on the Guile website]].

A collection of modules is provided for accessing and modifying gEDA objects and pages, called the gEDA Scheme API.  The //gEDA Scheme Reference Manual// is also available as an Info manual (''[[info://geda-scheme|info geda-scheme]]'').

==== Tutorials ====

  * [[gnetlist scheme tutorial|Scripting a gnetlist backend in scheme]] (John Doty)

See also the [[geda:gschem_ug:extensions|Extending gschem]] section of the //[[geda:gschem_ug|gEDA gschem User Guide]]//, and [[geda:gnetlist_ug#scheme_backend_api|Scheme Backend API]] section of the //[[geda:gnetlist_ug|gEDA gnetlist User Guide]]//.

==== Reference documents ====
  * [[gnetlist Scheme primitives]]
  * [[gschem repl|Using REPL in gschem]]

==== Scripting examples ====
You can download each script example and load it in **gschem**:
  * just hit <key>:</key> and enter <code lisp>(load "filename.scm")</code>
  * then hit <key>Enter</key>

You can install them as well if you don't want to load them every time:
  * copy the script you want into your //''~/.gEDA''// directory
  * put the line <code lisp>(load "filename.scm")</code> into your //''~/.gEDA/gschemrc''// (replace //filename.scm// with the real name of the script)


=== Removing objects with specific properties ===
For instance, let's remove all objects which are circles or arcs
with zero radius:

<file lisp remove-objects.scm>
(use-modules (geda page))

; Checks if the OBJECT is a circle or an arc with zero radius
(define (zero-radius-object? object)
  (or
    (and (circle? object) (= (circle-radius object) 0))
    (and (arc?    object) (= (arc-radius    object) 0))))

(apply page-remove! (active-page)
       (filter
         zero-radius-object?
         (page-contents (active-page))))
</file>

Let's suppose we have a component with a known attribute to
remove, then we have to detach and remove all its attributes, too.
The function below does exactly this.
<file lisp remove-components-with-attribs.scm>
(use-modules (geda page))
(use-modules (geda object))
(use-modules (geda attrib))

; Removes all components having the attrib NAME=VALUE from PAGE
(define (delete-components-by-attrib! page name value)
  (for-each
    (lambda (obj)
      (if (component? obj)
        (for-each
          (lambda (attr)
            (and
              (string=? (attrib-name attr) name)
              (string=? (attrib-value attr) value)
              (let ((attached-attribs (object-attribs obj)))
                (apply detach-attribs! obj attached-attribs)
                (apply page-remove! page obj attached-attribs))))
          (object-attribs obj))))
    (page-contents page)))
</file>

After loading the file, hit <key>:</key> and enter, for example,
<code lisp>
(delete-components-by-attrib! (active-page) "refdes" "R1")
</code>

=== Procedures for input-output ===
The following script defines two procedures that can be used in
**gaf shell** batch scripts:
  * ''schematic-file->page''
  * ''page->schematic-file''

<file lisp geda-io.scm>
(use-modules (ice-9 lineio))
(use-modules (geda page))

; Input/output procedures
; reads FILE and outputs string
(define (file->string file)
  (let* ((port (make-line-buffering-input-port (open-file file "r"))))
    (do ((line "" (read-string port))
         (s "" (string-append s line)))
      ((eof-object? line) ; test
       (close-port port)  ; expression(s) to evaluate in the end
       s)                 ; return value
      ; empty body
      )))

; reads schematic FILE and outputs PAGE object
(define (schematic-file->page file)
    (string->page file (file->string file)))

; saves schematic PAGE to FILE
(define (page->schematic-file page file)
  (with-output-to-file file
    (lambda () (display (page->string page)))))
</file>


=== Copy, move, and rotate objects ===
<file lisp move-and-rotate.scm>
; Scripting example by vzh per request of Kai-Martin Knaak :-)
; Use at your own risk.

; The main procedure here is
; multiple-copy-move-and-rotate-selection which can be abbreviated
; as mcmars.
; Usage:
;   launch gschem so it can use this script, e.g.
;     gschem -s move-and-rotate.scm
;   select objects in gschem, then hit ':' (semicolon) and type
;     (mcmars '(1000 . 500) 90 10)
;   hit <Enter>
; Enjoy!


(use-modules (gschem selection))

; align coords by ALIGN
(define (ceiling-coords vector align)
  (cons
    (* (ceiling-quotient (car vector) align) align)
    (* (ceiling-quotient (cdr vector) align) align)
    ))

; Get minimum X and minimum Y of two pairs of coords
(define (min-coords coord1 coord2)
  (let ((x (min (car coord1) (car coord2)))
        (y (min (cdr coord1) (cdr coord2))))
    ; return value
    (cons x y)))

; Copy, move and rotate current selection. The selected objects
; are first copied, then translated by VECTOR and finally rotated
; by ANGLE about center which is calculated as rounded by 100
; lower left coordinate of all objects in selection.
; If no objects are selected, opens gschem message dialog with
; warning.
; Returns the copied objects.
(define (copy-move-and-rotate-selection vector angle)
  (let ((objects (page-selection (active-page))))
    (if (null? objects)
      (gschem-msg "Select something first!")
      ; else
      (let* ((copied-objects (map copy-object objects))
             (translated-objects (apply translate-objects! vector copied-objects))
             (bounds (apply object-bounds translated-objects))
             (rotation-center (ceiling-coords (min-coords (car bounds) (cdr bounds)) 100))
             (rotated-objects (apply rotate-objects! rotation-center angle translated-objects)))
        (apply page-append! (active-page) rotated-objects)
        rotated-objects)
      )))

; Multiply VECTOR which must be a pair by NUMBER
(define (multiply-vector-by vector number)
  (cons (* number (car vector)) (* number (cdr vector))))

; Copy, move and rotate current selection NUMBER times. Applies
; the copy-move-and-rotate-selection procedure multiple times
; increasing every time vector and angle by given values of VECTOR
; and ANGLE.
; If no objects are selected, opens gschem message dialog with
; warning.
; Return value is unspecified.
(define (multiple-copy-move-and-rotate-selection vector angle num)
  (if (null? (page-selection (active-page)))
    (gschem-msg "Select something first!")
    ; else
    (do ((i num (1- i)))
      ((= i 0))
      (copy-move-and-rotate-selection
        (multiply-vector-by vector i) (* angle i)))
    ))

; Abbreviated name for the multiple-copy-move-and-rotate-selection
; procedure
(define mcmars multiple-copy-move-and-rotate-selection)
</file>


=== Group attribute editing ===
Let's suppose you have selected several resistors' refdeses and
want to rename them at once, e.g., if they were copy from another
place.
<file lisp set-selected-attribs-value>
(use-modules (gschem selection))

(define (set-selected-attribs-value! value)
  (for-each
    (lambda (attrib)
      (set-attrib-value! attrib value))
    (page-selection (active-page))))
</file>

Usage of the procedure in **gschem**:
<code lisp>
(set-selected-attribs-value! "R100.?")
</code>

Now, after renumbering them using <key>t</key> <key>u</key>, you
copy them all and want to rename those copied resistors appending a suffix:
<file lisp append-selected-attribs-suffix.scm>
(use-modules (gschem selection))

(define (append-selected-attribs-suffix! suffix)
  (for-each
    (lambda (attrib)
      (set-attrib-value!
        attrib
        (string-append (attrib-value attrib) suffix)))
    (page-selection (active-page))))
</file>

Usage of the procedure in **gschem**:
<code lisp>
(append-selected-attribs-suffix! "-top")
</code>

Now, let's rename some other attributes by adding a prefix:
<file lisp append-selected-attribs-prefix.scm>
(use-modules (gschem selection))

(define (append-selected-attribs-prefix! prefix)
  (for-each
    (lambda (object)
      (and (attribute? object)
           (set-attrib-value!
             object
             (string-append prefix (attrib-value object)))))
    (page-selection (active-page))))
</file>

Usage of the procedure in **gschem**:
<code lisp>
(append-selected-attribs-prefix! "A1.")
</code>

Let's replace first letters of selected attribs with prefix:
<file lisp append-selected-attribs-prefix.scm>
(use-modules (gschem selection))

(define (replace-selected-attribs-prefix! prefix)
  (for-each
    (lambda (object)
      (and (attribute? object)
           (set-attrib-value!
             object
             (string-append
               prefix
               (string-copy (attrib-value object) 1)))))
    (page-selection (active-page))))
</file>

Usage of the procedure in **gschem**:
<code lisp>
(replace-selected-attribs-prefix! "C")
</code>

Let's rename selected ''netname='' attributes increasing them by a
fixed number:
<file lisp add-selected-attribs-number.scm>
(use-modules (gschem selection))

(define (add-selected-attribs-number! number)
  (for-each
    (lambda (object)
      (and (attribute? object)
           (set-attrib-value!
             object
             (number->string
               (+ (string->number (attrib-value object)) number)))))
    (page-selection (active-page))))
</file>

Usage of the procedure in **gschem**:
<code lisp>
(add-selected-attribs-number! 100)
</code>

We could set any function instead of "+" on the net number in this procedure.
For instance:
<file lisp use-another-func.scm>
(use-modules (gschem selection))

(define (use-another-func! func)
  (for-each
    (lambda (object)
      (and (attribute? object)
           (set-attrib-value!
             object
             (number->string
               (func (string->number (attrib-value object)))))))
    (page-selection (active-page))))
</file>

Usage of the procedure in **gschem**:
<code lisp>
(use-another-func! -)
(define (multiply-by-2 x)
  (* 2 x))
(use-another-func! multiply-by-2)
</code>

=== Moving objects using arrows ===
Let's define actions to move selected objects using
<key>Shift</key> + arrow keys.

<file lisp arrow-move.scm>
(use-modules (gschem selection))

; Default offset to move
(define offset 100)

; Get moving vector
(define (move-selection direction)
  (apply translate-objects!
    (case direction
      ((left ) (cons (- offset) 0))
      ((right) (cons (+ offset) 0))
      ((down ) (cons 0 (- offset)))
      ((up   ) (cons 0 (+ offset)))
      (else #f))
    (page-selection (active-page))))

; Define actions
(define (&move-selection-left ) (move-selection 'left ))
(define (&move-selection-right) (move-selection 'right))
(define (&move-selection-down ) (move-selection 'down ))
(define (&move-selection-up   ) (move-selection 'up   ))

; Define shortcuts
(global-set-key "<Shift>Left"  '&move-selection-left)
(global-set-key "<Shift>Right" '&move-selection-right)
(global-set-key "<Shift>Up"    '&move-selection-up)
(global-set-key "<Shift>Down"  '&move-selection-down)
</file>

The following script redefines current shortcuts so that if
nothing is selected the canvas is moved with arrow keys (without
<key>Shift</key> in this case), otherwise selected objects are
moved.

<file lisp arrow-move2.scm>
(use-modules (gschem selection))

; Default offset to move
(define offset 100)

; Get moving vector
(define (move-selection direction)
  (let ((selection (page-selection (active-page))))
    (if (null? selection)
      ; default behaviour
      (case direction
          ((left ) (&view-pan-left))
          ((right) (&view-pan-right))
          ((down ) (&view-pan-down))
          ((up   ) (&view-pan-up))
          (else #f))
      ; modified behaviour
      (apply translate-objects!
        (case direction
          ((left ) (cons (- offset) 0))
          ((right) (cons (+ offset) 0))
          ((down ) (cons 0 (- offset)))
          ((up   ) (cons 0 (+ offset)))
          (else #f))
        (page-selection (active-page))))
    ))

; Define actions
(define (&move-selection-left ) (move-selection 'left ))
(define (&move-selection-right) (move-selection 'right))
(define (&move-selection-down ) (move-selection 'down ))
(define (&move-selection-up   ) (move-selection 'up   ))

; Define shortcuts
(global-set-key "Left"  '&move-selection-left)
(global-set-key "Right" '&move-selection-right)
(global-set-key "Up"    '&move-selection-up)
(global-set-key "Down"  '&move-selection-down)
</file>
