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-action (&pcb-about
 215                 #:name       (_ "About PCB Major Mode")
 216                 #:label      (_ "About PCB Major Mode...")
 217                 #:menu-label (_ "About..."))
 218   (gschem-msg (string-append
 219                "This is the pcb major mode for gschem\n"
 220                "pcb.scm version $Id$\n"
 221                "***** WARNING *****\n"
 222                "This is highly experimental\n"
 223                "You should save your work often\n"
 224                "and keep backup copies.  You have\n"
 225                "been warned.\n"
 226                )
 227               )
 228   )
 229
 230 (define-action (&pcb-launch
 231                 #:name       (_ "Launch PCB")
 232                 #:label      (_ "Launch PCB...")
 233                 #:menu-label (_ "Launch PCB..."))
 234   ;; We don't want to crash on a SIGPIPE if the user
 235   ;; exits from PCB
 236   (if pcb:pipe
 237       (begin
 238         (gschem-log "PCB is already running\n")
 239         (gschem-msg "PCB is already running\n")
 240         )
 241
 242       (begin
 243         (if (gschem-confirm "Start pcb?")
 244             (begin
 245               (sigaction SIGPIPE SIG_IGN)
 246               (gschem-log "Launching PCB\n")
 247               (set! pcb:pipe (open-output-pipe
 248                               (string-append pcb:pcb-cmd " --listen")
 249                               )
 250                     )
 251               (if (not pcb:pipe)
 252                   (gschem-log "Failed to launch PCB\n")
 253                   (gschem-log "Launched PCB\n")
 254                   )
 255               )
 256             (gschem-msg "Not launching PCB\n")
 257             )
 258         )
 259       )
 260   )
 261
 262 (define-action (&pcb-run-gsch2pcb
 263                 #:name       (_ "Run gsch2pcb")
 264                 #:label      (_ "Run gsch2pcb...")
 265                 #:menu-label (_ "Run gsch2pcb..."))
 266   (gschem-log "Running gsch2pcb")
 267   (system pcb:gsch2pcb-cmd)
 268 )
 269
 270 (define-action (&pcb-run-editor
 271                 #:icon       "accessories-text-editor"
 272                 #:name       (_ "Edit gsch2pcb Project")
 273                 #:label      (_ "Edit gsch2pcb Project...")
 274                 #:menu-label (_ "Edit gsch2pcb Project..."))
 275   (system pcb:editor-cmd)
 276 )
 277
 278 (define-action (&pcb-load-project
 279                 #:icon       "gtk-open"
 280                 #:name       (_ "Load gsch2pcb Project")
 281                 #:label      (_ "Load gsch2pcb Project...")
 282                 #:menu-label (_ "Load gsch2pcb Project...")
 283                 #:tooltip    (_ "Not implemented yet"))
 284   (let ((f nil))
 285     (gschem-msg "This menu choice does not really do anything yet other than select a file\n")
 286
 287     (set! f (gschem-filesel "Select Project File" pcb:project-file-name  'open 'must_exist))
 288     (if f (set! pcb:project-file-name f) )
 289   )
 290 )
 291
 292 (define-action (&pcb-save-project
 293                 #:icon       "gtk-save"
 294                 #:name       (_ "Save gsch2pcb Project")
 295                 #:label      (_ "Save gsch2pcb Project...")
 296                 #:menu-label (_ "Save gsch2pcb Project...")
 297                 #:tooltip    (_ "Not implemented yet"))
 298   (let ((f nil))
 299     (gschem-msg "This menu choice does not really do anything yet other than select a file\n")
 300
 301     (set! f (gschem-filesel "Save Project File As" pcb:project-file-name 'save 'may_exist))
 302     (if f (set! pcb:project-file-name f) )
 303   )
 304 )
 305
 306 (global-set-key "P L" &pcb-launch)
 307 (global-set-key "P N" &pcb-run-gsch2pcb)
 308 (global-set-key "P E" &pcb-run-editor)
 309 (global-set-key "P O" &pcb-load-project)
 310 (global-set-key "P S" &pcb-save-project)
 311 (global-set-key "P question" &pcb-about)
 312
 313 (define pcb-menu
 314   `((,&pcb-launch)
 315     (,&pcb-run-gsch2pcb
 316      ,&pcb-run-editor
 317      ,&pcb-load-project
 318      ,&pcb-save-project)
 319     (,&pcb-about)))
 320
 321 ;; Insert as second-to-last item in the menubar (last one is "Help")
 322 (let ((x (list-tail menubar (- (length menubar) 2))))
 323   (set-cdr! x (cons (cons (_ "PCB") pcb-menu) (cdr x))))