gEDA-cvs: CVS update: gnet-allegro.scm

[cvspsrv@xxxxxxxx]

  User: cnieves 
  Date: 07/02/20 07:27:15

  Modified:    .        gnet-allegro.scm
  Log:
  Fix bug #1663729. Create the 'devfiles' dir if needed.
  
  
  
  * scheme/gnet-allegro.scm: Fix bug #1663729.
  
    When writing the device files, check if 'devfiles' directory 
  
    exists and create it if needed.
  
  
  
  
  Revision  Changes    Path
  1.12      +34 -1     eda/geda/gaf/gnetlist/scheme/gnet-allegro.scm
  
  (In the diff below, changes in quantity of whitespace are not shown.)
  
  Index: gnet-allegro.scm
  ===================================================================
  RCS file: /home/cvspsrv/cvsroot/eda/geda/gaf/gnetlist/scheme/gnet-allegro.scm,v
  retrieving revision 1.11
  retrieving revision 1.12
  diff -u -b -r1.11 -r1.12
  --- gnet-allegro.scm	3 Feb 2005 12:49:36 -0000	1.11
  +++ gnet-allegro.scm	20 Feb 2007 12:27:15 -0000	1.12
  @@ -1,4 +1,4 @@
  -;;; $Id: gnet-allegro.scm,v 1.11 2005/02/03 12:49:36 danmc Exp $
  +;;; $Id: gnet-allegro.scm,v 1.12 2007/02/20 12:27:15 cnieves Exp $
   ;;;
   ;;; gEDA - GNU Electronic Design Automation
   ;;; gnetlist - GNU Netlist
  @@ -34,6 +34,39 @@
   
   (define allegro:write-device
      (lambda (device package)
  +
  +      ;; Check if the 'devfiles' directory exist.
  +      (if (not (access? "devfiles" F_OK))
  +	  (if (access? "." W_OK) 
  +	      ;; If the 'devfiles' directory doesn't exist, and 
  +	      ;; we have write access to the current directory, then create it.
  +	      (mkdir "devfiles")
  +	      ;; If we don't have write access to the current directory,
  +	      ;; end with an error message.
  +	      (begin
  +		(error (string-append
  +			"the device files are expected to be in the 'devfiles' directory.\n"
  +			"       However, can't create it!.\n"
  +			"       Check write permissions of the current directory.\n"))))
  +	  ;; If 'devfiles' exist, check if it is a directory.
  +	  (if (not (eq? (stat:type (stat "devfiles")) 'directory))
  +	      (begin
  +		;; 'devfiles' exists, but it is not a directory.
  +		;; End with an error message.
  +		(error (string-append 
  +			"the device files are expected to be in the 'devfiles' directory.\n"
  +			"       However, 'devfiles' exists and it is not a directory!.\n"))
  +		)))
  +      ;; 'devfiles' should exist now. Check if we have write access.
  +      (if (not (access? "devfiles" W_OK))
  +	  ;; We don't have write access to 'devfiles'. 
  +	  ;; End with an error message
  +	  (error (string-append
  +		  "the device files are expected to be in the 'devfiles' directory.\n"
  +		  "       However, can't access it for writing!.\n"
  +		  "       Check write permissions of the 'devfiles' directory.\n")))
  +   
  +
         (let ((p (open-output-file (string-downcase! (string-append "devfiles/" (string-append device ".txt"))))))
            (display "(Device File generated by gEDA Allegro Netlister)\n" p)
            (display "PACKAGE " p)
  
  
  


_______________________________________________
geda-cvs mailing list
geda-cvs@xxxxxxxxxxxxxx
http://www.seul.org/cgi-bin/mailman/listinfo/geda-cvs