Re: [Chicken-hackers] Using new chicken-install -reinstall

[Kon Lovett]

Hello again,

The infolist item is changed to remove redundancy and is now just "egg- 
name". Below is an updated program.

(use extras files posix srfi-1 miscmacros)

;; Write the elements of the list `ls' to the output-port or output- 
file, using
;; the `writer' procedure. `writer' is a (procedure (* output-port)).
;;
;; (add `newline?' param for write #\newline after every element?)
(define (write-file ls #!optional (file-or-port (current-output-port))  
(writer write))
  (let ((port (if (port? file-or-port) file-or-port
                (open-output-file file-or-port) ) ) )
    (dynamic-wind
      void
      (lambda () (for-each (cut writer <> port) ls))
      (lambda () (unless (port? file-or-port) (close-output-port  
port)))) ) )

#;
(define (write-file ls #!optional (file-or-port (current-output-port))  
(writer write))
  (let* ((port (if (port? file-or-port) file-or-port
                 (open-output-file file-or-port) ) )
         (closit (lambda () (unless (port? file-or-port) (close- 
output-port port)))) )
    (handle-exceptions exn
        (begin (closit) (abort exn))
      (for-each (cut writer <> port) ls))
    (closit) ) )

(define-constant +info-extn+ "setup-info")

(define (info-filenames #!optional (dir (repository-path)))
  (let ((cd (current-directory)))
    (current-directory dir)
    (begin0
      (map pathname-file (glob (make-pathname '() "*" +info-extn+)))
      (current-directory cd) ) ) )

(define (get-info eggnam #!optional (dir (repository-path)))
  (car (read-file (make-pathname dir eggnam +info-extn+))) )

(define (put-info info eggnam #!optional (dir (repository-path)))
  (let ((tmpfil (create-temporary-file)))
    (write-file (list info) tmpfil)
    (file-move tmpfil (make-pathname dir eggnam +info-extn+) #t) ) )

; no protection against existing "egg-name-and-version"
(define (update-info info eggnam)
  (cons `(egg-name ,eggnam) info) )

(define (update-info-file eggnam #!optional (dir (repository-path)))
  (put-info (update-info (get-info eggnam dir) eggnam) eggnam dir) )

(define (main #!optional (dir (cadr (argv))))
  (let ((eggdir (make-pathname `(,dir "chicken-eggs" "release" "4")  
""))
        (repdir (repository-path)) )
    (newline)
    (print "Local SVN Egg Repository: " eggdir)
    (print "Installed Egg Repository: " repdir)
    (newline)
    (let* ((egdrnms (directory eggdir))
           (siflnms (info-filenames repdir))
           (eggnams (lset-intersection string=? egdrnms siflnms)) )
    (for-each
      (lambda (eggnam)
        (print eggnam)
        (update-info-file eggnam) )
      eggnams ) ) ) )

#; ;remove this line when compiling,  otherwise just load into csi &  
invoke main w/ a dir-name
(main)