gschem/scheme/pcb.scm

   1 ;; -*- Scheme -*-
   2 ;;
   3 ;; Copyright (C) 2006-2010 Dan McMahill
   4 ;;
   5 ;; This program is free software; you can redistribute it and/or modify
   6 ;; it under the terms of the GNU General Public License as published by
   7 ;; the Free Software Foundation; either version 2 of the License, or
   8 ;; (at your option) any later version.
   9 ;;
  10 ;; This program is distributed in the hope that it will be useful,
  11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 ;; GNU General Public License for more details.
  14 ;;
  15 ;; You should have received a copy of the GNU General Public License
  16 ;; along with this program; if not, write to the Free Software
  17 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18 ;;
  19 ;;
  20
  21
  22 ;; ** WARNING **
  23 ;; This file contains highly experimental code.  Use at your own risk.
  24 ;;
  25 ;; TODO
  26 ;;  Note:  This list is incomplete.
  27 ;;
  28 ;; - complete a project file which is essentially the same as a gsch2pcb
  29 ;;   project file.
  30 ;;
  31 ;; - figure out how we should specify gsch2pcb arguments.  The project file?
  32 ;;
  33 ;; - figure out how to launch a gsch2pcb editor to modify the gsch2pcb project
  34 ;;   file.
  35 ;;
  36 ;; - figure out how to capture standard output from gsch2pcb and put it to
  37 ;;   the gschem log.  Perhaps a gschem-system-and-log function?
  38 ;;
  39 ;; - tell the listening pcb to load the new netlist and also load the
  40 ;;   new elements to the paste buffer after running gsch2pcb
  41 ;;
  42 ;; - when launching pcb, tell it to load the correct file or maybe after after
  43 ;;   running gsch2pcb, tell pcb what to load.
  44 ;;
  45 ;; - back annotate (once we implement it)
  46 ;;
  47 ;; - figure out how to have pcb talk back to gschem for selecting/deselecting
  48 ;;   elements.
  49 ;;
  50 ;; - figure out how to install the hotkeys
  51 ;;
  52
  53 (use-modules (ice-9 popen))
  54
  55 (gschem-log "Loading the PCB major mode\n")
  56 (gschem-log "PCB-mode version $Id$\n")
  57 (gschem-log "The PCB major mode is incomplete and considered experimental at this time\n")
  58
  59 ;; These may be changed by the user in their gafrc files (FIXME -- make this
  60 ;; preceeding comment be true)
  61
  62 ;; Various executibles
  63 (define pcb:pcb-cmd "pcb")
  64 (define pcb:gsch2pcb-cmd "gsch2pcb")
  65
  66 ;; FIXME
  67 ;; should probably look for a value defined in a gafrc, the EDITOR env variable,
  68 ;; and then some default here.
  69 (define pcb:editor-cmd "emacs &")
  70
  71 ;; In general, we should probably load gnetlist.scm and the appropriate
  72 ;; gnetlist backend to have the refdes aliasing code available.
  73
  74 (define pcb:pipe #f)
  75
  76 (define pcb:project-file-name "")
  77
  78 ;; (close-pipe pcb:pipe)
  79
  80 ;; Use this instead of
  81 ;; (display val pcb:pipe)
  82 ;;
  83 (define (pcb:pipe-write val)
  84   (if pcb:pipe
  85
  86       ;; pipe is open so try and write out our value
  87       (begin
  88         (catch #t
  89
  90                ;; try to write our value
  91                (lambda ()
  92                  (display val pcb:pipe)
  93                  )
  94
  95                ;; and if we fail spit out a message
  96                ;; and set pcb:pipe to false so we don't
  97                ;; try and write again
  98                (lambda (key . args)
  99                  (gschem-log "It appears that PCB has terminated.\n")
 100                  (gschem-log "If this is not the case, you should save and exit and\n")
 101                  (gschem-log "report this as a bug.\n\n")
 102                  (gschem-log "If you exited PCB on purpose, you can ignore \n")
 103                  (gschem-log "this message\n\n")
 104                  (set! pcb:pipe #f)
 105                  )
 106
 107                )
 108         )
 109
 110       ;; pipe is not open so don't try and write to it
 111       ;;(display "pcb:pipe is not open\n")
 112
 113       )
 114
 115 )
 116
 117 ;;
 118 ;;
 119 ;; pcb-select-component-hook
 120 ;;
 121
 122 (define (pcb-select-component-hook attribs)
 123
 124   (for-each
 125      (lambda (attrib)
 126        (let* ((name-value (get-attribute-name-value attrib))
 127               (name (car name-value))
 128               (value (cdr name-value))
 129              )
 130              (if (string=? name "refdes")
 131                  (let ()
 132                   (pcb:pipe-write "Select(ElementByName, ^")
 133                   (pcb:pipe-write value)
 134                   (pcb:pipe-write "$)\n")
 135                   )
 136                  )
 137              )
 138        )
 139       attribs
 140       )
 141 )
 142
 143 ;;
 144 ;;
 145 ;; pcb-deselect-component-hook
 146 ;;
 147
 148 (define (pcb-deselect-component-hook attribs)
 149   (for-each
 150      (lambda (attrib)
 151        (let* ((name-value (get-attribute-name-value attrib))
 152               (name (car name-value))
 153               (value (cdr name-value))
 154              )
 155              (if (string=? name "refdes")
 156                  (let ()
 157                   (pcb:pipe-write "Unselect(ElementByName, ^")
 158                   (pcb:pipe-write value)
 159                   (pcb:pipe-write "$)\n")
 160                   )
 161                  )
 162              )
 163        )
 164       attribs
 165       )
 166 )
 167
 168 ;;
 169 ;;
 170 ;; pcb-select-net-hook
 171 ;;
 172
 173 (define (pcb-select-net-hook attribs)
 174   ;; Select net hook
 175   #t
 176 )
 177
 178 ;;
 179 ;;
 180 ;; pcb-deselect-net-hook
 181 ;;
 182
 183 (define (pcb-deselect-net-hook attribs)
 184   ;; Select net hook
 185   #t
 186 )
 187
 188 ;;
 189 ;;
 190 ;; pcb-deselect-all-hook
 191 ;;
 192
 193 (define (pcb-deselect-all-hook attribs)
 194   (pcb:pipe-write "Unselect(All)\n")
 195 )
 196
 197 ;;
 198 ;;
 199 ;; Add the hooks
 200 ;;
 201 (add-hook! deselect-component-hook pcb-deselect-component-hook)
 202 (add-hook! deselect-net-hook pcb-deselect-net-hook)
 203 (add-hook! deselect-all-hook pcb-deselect-all-hook)
 204 (add-hook! select-component-hook pcb-select-component-hook)
 205 (add-hook! select-net-hook pcb-select-net-hook)
 206
 207
 208 ;;
 209 ;;
 210 ;; Menus
 211 ;;
 212 ;;
 213 ;;
 214 (define (pcb:about)
 215   (gschem-msg (string-append
 216                "This is the pcb major mode for gschem\n"
 217                "pcb.scm version $Id$\n"
 218                "***** WARNING *****\n"
 219                "This is highly experimental\n"
 220                "You should save your work often\n"
 221                "and keep backup copies.  You have\n"
 222                "been warned.\n"
 223                )
 224               )
 225   )
 226
 227 (define (pcb:launch-pcb)
 228   ;; We don't want to crash on a SIGPIPE if the user
 229   ;; exits from PCB
 230   (if pcb:pipe
 231       (begin
 232         (gschem-log "PCB is already running\n")
 233         (gschem-msg "PCB is already running\n")
 234         )
 235
 236       (begin
 237         (if (gschem-confirm "Start pcb?")
 238             (begin
 239               (sigaction SIGPIPE SIG_IGN)
 240               (gschem-log "Launching PCB\n")
 241               (set! pcb:pipe (open-output-pipe
 242                               (string-append pcb:pcb-cmd " --listen")
 243                               )
 244                     )
 245               (if (not pcb:pipe)
 246                   (gschem-log "Failed to launch PCB\n")
 247                   (gschem-log "Launched PCB\n")
 248                   )
 249               )
 250             (gschem-msg "Not launching PCB\n")
 251             )
 252         )
 253       )
 254   )
 255
 256 (define (pcb:run-gsch2pcb)
 257   (gschem-log "Running gsch2pcb")
 258   (system pcb:gsch2pcb-cmd)
 259 )
 260
 261 (define (pcb:run-editor)
 262   (system pcb:editor-cmd)
 263 )
 264
 265 (define (pcb:load-project)
 266   (let ((f nil))
 267     (gschem-msg "This menu choice does not really do anything yet other than select a file\n")
 268
 269     (set! f (gschem-filesel "Select Project File" pcb:project-file-name  'open 'must_exist))
 270     (if f (set! pcb:project-file-name f) )
 271   )
 272 )
 273
 274 (define (pcb:save-project)
 275   (let ((f def nil))
 276     (gschem-msg "This menu choice does not really do anything yet other than select a file\n")
 277
 278     (set! f (gschem-filesel "Save Project File As" pcb:project-file-name 'save 'may_exist))
 279     (if f (set! pcb:project-file-name f) )
 280   )
 281 )
 282
 283 ; All keys in this keymap *must* be unique
 284 (define pcb:pcb-keymap
 285   '(
 286     ("?" . pcb:about)
 287     ("l" . pcb:launch-pcb)
 288     ("n" . pcb:run-gsch2pcb)
 289     ("e" . pcb:run-editor)
 290     ("o" . pcb:load-project)
 291     ("s" . pcb:save-project)
 292     )
 293   )
 294
 295 (define pcb:menu-items
 296 ;;
 297 ;;          menu item name      menu action             menu hotkey action
 298 ;;
 299         '( ("About..."                   pcb:about               pcb:about)
 300            ("Launch PCB"                 pcb:launch-pcb          pcb:launch-pcb)
 301            ("Run gsch2pcb"               pcb:run-gsch2pcb        pcb:run-gsch2pcb)
 302            ("Edit gsch2pcb project"      pcb:run-editor          pcb:run-editor)
 303            ("Load Project..."            pcb:load-project        pcb:load-project)
 304            ("Save Project..."            pcb:save-project        pcb:save-project)
 305            )
 306 )
 307
 308 (add-menu "PCB" pcb:menu-items)
 309
 310