[Top][All Lists]

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

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

From: Kon Lovett
Subject: Re: [Chicken-hackers] Using new chicken-install -reinstall
Date: Thu, 12 May 2011 08:19:07 -0700

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) ) ) )
      (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)
      (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)) )
    (print "Local SVN Egg Repository: " eggdir)
    (print "Installed Egg Repository: " repdir)
    (let* ((egdrnms (directory eggdir))
           (siflnms (info-filenames repdir))
           (eggnams (lset-intersection string=? egdrnms siflnms)) )
      (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

reply via email to

[Prev in Thread] Current Thread [Next in Thread]