Changeset 12786 in project for chicken


Ignore:
Timestamp:
12/05/08 15:08:07 (11 years ago)
Author:
felix winkelmann
Message:

removed setup-utils (merged into setup-api)

Location:
chicken/trunk
Files:
1 deleted
7 edited

Legend:

Unmodified
Added
Removed
  • chicken/trunk/TODO

    r12703 r12786  
    1919*** dirty-macros.scm loops when using `defile'
    2020    possibly due to unrenamed special forms
     21*** extended lambda-lists refer to `optional' and `let-optionals[*]'
     22    this will break, when these macros are renamed on import
    2123*** slow
    2224    compiling dynamic.scm with profile-hacked expand:
     
    130132
    131133** modules
     134*** import lib holds undefined in expansions for undefined but exported bindings
    132135*** `require-extension' fails in interpreter when extension is .so without import library
    133136    probably because load and import is in same toplevel form, and the
     
    136139    compile-/expansion-time), when import is #t and o import lib
    137140    exists.
     141
     142** setup/install
     143*** qs: automatically quote with #\" and replace #\/ with #\\ on windows?
     144
     145** build
     146*** compiling chicken-install/-uninstall must use invalid or disabled existing repository
     147    otherwise we use stale import libraries
     148
     149** libraries/build
     150*** check use of paths with windows builds: proper handling of quoting and
     151    slashed on all shell configurations?
    138152
    139153
     
    155169    should actually be a distinct meta-import-env.
    156170    (does it work at all?)
     171    example: we nbeed `(import-for-syntax chicken)' to have access to
     172    `receive' in a procedural syntax definition.
    157173*** curried define performs expansion in empty se - problem?
    158174    (as comment in expand.scm indicated (##sys#register-export))
    159175*** check phase separation and module access
    160176**** interaction for define-for-syntax, begin-for-syntax, and macros
    161      also check for different execution modes (compile-time, run-time, csi, ...)
    162 *** checks to be implemented
    163 **** reimport of imported id
    164 **** unused defs?
     177***** check for different execution modes (compile-time, run-time, csi, ...)
     178***** figure out visibility
    165179
    166180** compiler
     
    172186**** handle redirects in http-fetch
    173187*** automatically update db after extension installation?
     188*** test sudo
     189
     190** henrietta
     191*** mode that responses with list of available eggs (ls + check for .meta files)
     192*** mode that responses only with .meta information
    174193
    175194** library units
  • chicken/trunk/chicken-install.scm

    r12630 r12786  
    2525
    2626
    27 (require-library setup-utils setup-download)
     27(require-library setup-download setup-api)
    2828(require-library srfi-1 posix data-structures utils ports regex ports extras
    2929                 srfi-13 files)
     
    4242  (import scheme chicken srfi-1 posix data-structures utils ports regex ports extras
    4343          srfi-13 files)
    44   (import setup-utils setup-download)
     44  (import setup-download setup-api)
    4545 
    4646  (import foreign)
     
    7777  (define *keep* #f)
    7878  (define *force* #f)
    79   (define *sudo* #f)
    8079  (define *prefix* #f)
    8180  (define *host-extension* #f)
     
    251250                               (lambda (e)
    252251                                 (print "removing previously installed extension `" e "' ...")
    253                                  (remove-extension e *sudo*) )
     252                                 (remove-extension e) )
    254253                               ueggs)
    255254                              (retrieve ueggs))))))
     
    272271                         "~a/csi -bnq -e \"(require-library setup-api)\" -e \"(import setup-api)\" ~a ~a ~a ~a ~a ~a"
    273272                         *program-path*
    274                          (if *sudo* "-e \"(sudo-install #t)\"" "")
     273                         (if (sudo-install) "-e \"(sudo-install #t)\"" "")
    275274                         (if *keep* "-e \"(keep-intermediates #t)\"" "")
    276275                         (if *no-install* "-e \"(setup-install-flag #f)\"" "")
     
    297296
    298297  (define (update-db)
    299     (let ((files (glob (make-pathname (repository-path) "*.import.*")))
    300           (dbfile (make-pathname (repository-path) +module-db+)))
     298    (let* ((files (glob (make-pathname (repository-path) "*.import.*")))
     299           (tmpdir (create-temporary-directory))
     300           (dbfile (make-pathname tmpdir +module-db+)))
    301301      (fluid-let ((##sys#warnings-enabled #f))
    302302        (for-each
     
    305305             (eval `(import ,(string->symbol (cadr m))))))
    306306         files))
    307       (print "generating database " dbfile)
     307      (print "generating database")
    308308      (let ((db
    309309             (sort
     
    321321                (string<? (symbol->string (car e1)) (symbol->string (car e2)))))))
    322322        (newline)
    323         (with-output-to-file (make-pathname (repository-path) +module-db+)
     323        (with-output-to-file dbfile
    324324          (lambda ()
    325             (for-each (lambda (x) (write x) (newline)) db))))))
     325            (for-each (lambda (x) (write x) (newline)) db)))
     326        (copy-file dbfile (make-pathname (repository-path) +module-db+))
     327        (remove-directory tmpdir))))
    326328
    327329  (define (usage code)
     
    387389                        (loop (cdr args) eggs))
    388390                       ((or (string=? arg "-s") (string=? arg "-sudo"))
    389                         (set! *sudo* #t)
     391                        (sudo-install #t)
    390392                        (loop (cdr args) eggs))
    391393                       ((or (string=? arg "-r") (string=? arg "-retrieve"))
  • chicken/trunk/chicken-status.scm

    r11966 r12786  
    4040       (concatenate (map (cut grep <> eggs) patterns))
    4141       string=?)))
     42
     43  (define (format-string str cols #!optional right (padc #\space))
     44    (let* ((len (string-length str))
     45           (pad (make-string (fxmax 0 (fx- cols len)) padc)) )
     46      (if right
     47          (string-append pad str)
     48          (string-append str pad) ) ) )
     49
     50  (define get-terminal-width
     51    (let ((default-width 80))        ; Standard default terminal width
     52      (lambda ()
     53        (let ((cop (current-output-port)))
     54          (if (terminal-port? cop)
     55              (let ((w (nth-value 1 (terminal-size cop))))
     56                (if (zero? w) default-width w))
     57              default-width)))))
    4258
    4359  (define (list-installed-eggs eggs)
  • chicken/trunk/chicken-uninstall.scm

    r12305 r12786  
    2525
    2626
    27 (require-library setup-utils srfi-1 posix data-structures utils ports regex srfi-13
    28                  files)
     27(require-library
     28 setup-api
     29 srfi-1 posix data-structures utils ports regex srfi-13 files)
    2930
    3031
     
    3233 
    3334  (import scheme chicken)
    34   (import setup-utils srfi-1 posix data-structures utils ports regex srfi-13 files)
     35  (import setup-api)
     36  (import srfi-1 posix data-structures utils ports regex srfi-13 files)
    3537
    3638  (define *force* #f)
    37   (define *sudo* #f)
    3839
    3940  (define (gather-eggs patterns)
     
    6970              (lambda (e)
    7071                (print "removing " e)
    71                 (remove-extension e *sudo*) )
     72                (remove-extension e) )
    7273              eggs)))))
    7374
     
    102103                   (loop (cdr args) pats))
    103104                  ((or (string=? arg "-s") (string=? arg "-sudo"))
    104                    (set! *sudo* #t)
     105                   (sudo-install #t)
    105106                   (loop (cdr args) pats))
    106107                  ((and (positive? (string-length arg))
  • chicken/trunk/distribution/manifest

    r12560 r12786  
    326326setup-download.scm
    327327setup-api.scm
    328 setup-utils.scm
    329328chicken-status.scm
    330329chicken-status.c
     
    338337chicken-uninstall.1
    339338setup-download.c
    340 setup-utils.c
    341339setup-api.c
    342340setup-api.import.c
    343 setup-utils.import.c
    344341setup-download.import.c
  • chicken/trunk/rules.make

    r12631 r12786  
    10231023        $(POSTINSTALL_PROGRAM) $(POSTINSTALL_PROGRAM_FLAGS) $(DESTDIR)$(IEGGDIR)/setup-api.so
    10241024        $(POSTINSTALL_PROGRAM) $(POSTINSTALL_PROGRAM_FLAGS) $(DESTDIR)$(IEGGDIR)/setup-download.so
    1025         $(POSTINSTALL_PROGRAM) $(POSTINSTALL_PROGRAM_FLAGS) $(DESTDIR)$(IEGGDIR)/setup-utils.so
    10261025        $(POSTINSTALL_PROGRAM) $(POSTINSTALL_PROGRAM_FLAGS) $(DESTDIR)$(IEGGDIR)/setup-api.import.so
    10271026        $(POSTINSTALL_PROGRAM) $(POSTINSTALL_PROGRAM_FLAGS) $(DESTDIR)$(IEGGDIR)/setup-download.import.so
    1028         $(POSTINSTALL_PROGRAM) $(POSTINSTALL_PROGRAM_FLAGS) $(DESTDIR)$(IEGGDIR)/setup-utils.import.so
    10291027        $(POSTINSTALL_PROGRAM) $(POSTINSTALL_PROGRAM_FLAGS) $(DESTDIR)$(IEGGDIR)/chicken.import.so
    10301028        $(POSTINSTALL_PROGRAM) $(POSTINSTALL_PROGRAM_FLAGS) $(DESTDIR)$(IEGGDIR)/lolevel.import.so
     
    10981096        $(INSTALL_PROGRAM) $(INSTALL_PROGRAM_EXECUTABLE_OPTIONS) setup-api.so $(DESTDIR)$(IEGGDIR)
    10991097        $(INSTALL_PROGRAM) $(INSTALL_PROGRAM_EXECUTABLE_OPTIONS) setup-download.so $(DESTDIR)$(IEGGDIR)
    1100         $(INSTALL_PROGRAM) $(INSTALL_PROGRAM_EXECUTABLE_OPTIONS) setup-utils.so $(DESTDIR)$(IEGGDIR)
    11011098
    11021099uninstall:
     
    12631260setup-download.import.c: $(SRCDIR)setup-download.scm
    12641261        $(CHICKEN) $(SRCDIR)setup-download.import.scm $(CHICKEN_IMPORT_LIBRARY_OPTIONS) -output-file $@
    1265 setup-utils.import.c: $(SRCDIR)setup-utils.scm
    1266         $(CHICKEN) $(SRCDIR)setup-utils.import.scm $(CHICKEN_IMPORT_LIBRARY_OPTIONS) -output-file $@
    12671262
    12681263chicken.c: $(SRCDIR)chicken.scm $(SRCDIR)chicken-ffi-syntax.scm $(SRCDIR)private-namespace.scm $(SRCDIR)tweaks.scm
     
    12851280chicken-profile.c: $(SRCDIR)chicken-profile.scm
    12861281        $(CHICKEN) $< $(CHICKEN_PROGRAM_OPTIONS) -output-file $@
    1287 chicken-install.c: $(SRCDIR)chicken-install.scm setup-download.c setup-utils.c
     1282chicken-install.c: $(SRCDIR)chicken-install.scm setup-download.c
    12881283        $(CHICKEN) $< $(CHICKEN_PROGRAM_OPTIONS) -output-file $@
    1289 chicken-uninstall.c: $(SRCDIR)chicken-uninstall.scm setup-utils.c
     1284chicken-uninstall.c: $(SRCDIR)chicken-uninstall.scm
    12901285        $(CHICKEN) $< $(CHICKEN_PROGRAM_OPTIONS) -output-file $@
    1291 chicken-status.c: $(SRCDIR)chicken-status.scm setup-utils.c
     1286chicken-status.c: $(SRCDIR)chicken-status.scm
    12921287        $(CHICKEN) $< $(CHICKEN_PROGRAM_OPTIONS) -output-file $@
    12931288csc.c: $(SRCDIR)csc.scm
     
    12961291        $(CHICKEN) $< $(CHICKEN_PROGRAM_OPTIONS) -output-file $@
    12971292
    1298 setup-api.c: $(SRCDIR)setup-api.scm setup-utils.c
     1293setup-api.c: $(SRCDIR)setup-api.scm
    12991294        $(CHICKEN) $< $(CHICKEN_DYNAMIC_OPTIONS) -emit-import-library setup-api -output-file $@
    1300 setup-download.c: $(SRCDIR)setup-download.scm setup-utils.c
     1295setup-download.c: $(SRCDIR)setup-download.scm
    13011296        $(CHICKEN) $< $(CHICKEN_DYNAMIC_OPTIONS) -emit-import-library setup-download -output-file $@
    1302 setup-utils.c: $(SRCDIR)setup-utils.scm
    1303         $(CHICKEN) $< $(CHICKEN_DYNAMIC_OPTIONS) -emit-import-library setup-utils -output-file $@
    13041297
    13051298# distribution files
  • chicken/trunk/setup-api.scm

    r12608 r12786  
    4444     test-compile try-compile copy-file run-verbose
    4545     required-chicken-version required-extension-version cross-chicken
    46      sudo-install keep-intermediates)
    47 
     46     sudo-install keep-intermediates
     47     version>=?
     48     create-temporary-directory
     49     remove-directory
     50     remove-extension
     51     read-info)
     52 
    4853  (import scheme chicken foreign
    4954          regex utils posix ports extras data-structures
     
    124129(define *target-libs* (foreign-value "C_TARGET_MORE_LIBS" c-string))
    125130(define *target-lib-home* (foreign-value "C_TARGET_LIB_HOME" c-string))
    126 
    127131(define *sudo* #f)
    128132
     
    221225(user-install-setup)
    222226
    223 ; Convert a string with a version (such as "1.22.0") to a list of the
    224 ; numbers (such as (1 22 0)). If one of the version components cannot
    225 ; be converted to a number, then it is kept as a string.
    226 
    227 #;(define (version-string->numbers string)
    228   (map (lambda (x) (or (string->number x) (->string x)))
    229        (string-split string ".")))
    230 
    231 ; Given two lists with numbers corresponding to a software version (as returned
    232 ; by version-string->numbers), check if the first is greater than the second.
    233 
    234 (define (version-numbers> a b)
    235   (cond ((null? a) #f)
    236         ((null? b)  #t)
    237         ((and (pair? a) (pair? b))
    238          (let ((a1 (car a))
    239                (an (cdr a))
    240                (b1 (car b))
    241                (bn (cdr b)))
    242           (cond ((and (number? a1) (number? b1))
    243                  (cond ((> a1 b1) #t) ((= a1 b1) (version-numbers> an bn)) (else #f)))
    244                 ((and (string? a1) (string? b1)) 
    245                  (cond ((string> a1 b1) #t) ((string= a1 b1) (version-numbers> an bn)) (else #f)))
    246                 (else (version-numbers> (cons (->string a1) an) (cons (->string b1) bn))))) )
    247         (else (error 'version-numbers> "invalid revisions: " a b))))
    248227
    249228(define create-directory-0
     
    280259  (make-parameter exit))
    281260
    282 (define (yes-or-no? str . default)
    283   (let ((def (optional default #f)))
    284     (let loop ()
    285       (printf "~%~A (yes/no/abort) " str)
    286       (when def (printf "[~A] " def))
    287       (flush-output)
    288       (let ((ln (read-line)))
    289         (cond ((eof-object? ln) (set! ln "abort"))
    290               ((and def (string=? "" ln)) (set! ln def)) )
    291         (cond ((string-ci=? "yes" ln) #t)
    292               ((string-ci=? "no" ln) #f)
    293               ((string-ci=? "abort" ln) ((abort-setup)))
    294               (else
    295                (printf "~%Please enter \"yes\", \"no\" or \"abort\".~%")
    296                (loop) ) ) ) ) ) )
    297 
     261(define (yes-or-no? str #!key default (abort (abort-setup)))
     262  (let loop ()
     263    (printf "~%~A (yes/no/abort) " str)
     264    (when default (printf "[~A] " default))
     265    (flush-output)
     266    (let ((ln (read-line)))
     267      (cond ((eof-object? ln) (set! ln "abort"))
     268            ((and default (string=? "" ln)) (set! ln default)) )
     269      (cond ((string-ci=? "yes" ln) #t)
     270            ((string-ci=? "no" ln) #f)
     271            ((string-ci=? "abort" ln) (abort))
     272            (else
     273             (printf "~%Please enter \"yes\", \"no\" or \"abort\".~%")
     274             (loop) ) ) ) ) )
     275 
    298276(define (patch which rx subst)
    299277  (when (setup-verbose-flag) (printf "patching ~A ...~%" which))
     
    748726   compile-only: #t) )
    749727
     728(define (version>=? v1 v2)
     729  (define (version->list v)
     730    (map (lambda (x) (or (string->number x) x))
     731         (string-split-fields "[-\\._]" v #:infix)))
     732  (let loop ((p1 (version->list v1))
     733             (p2 (version->list v2)))
     734    (cond ((null? p1) (null? p2))
     735          ((null? p2))
     736          ((number? (car p1))
     737           (and (if (number? (car p2))
     738                    (>= (car p1) (car p2))
     739                    (string>=? (number->string (car p1)) (car p2)))
     740                (loop (cdr p1) (cdr p2))))
     741          ((number? (car p2))
     742           (and (string>=? (car p1) (number->string (car p2)))
     743                (loop (cdr p1) (cdr p2))))
     744          ((string>=? (car p1) (car p2)) (loop (cdr p1) (cdr p2)))
     745          (else #f))))
     746
     747(define (read-info egg)
     748  (with-input-from-file
     749      (make-pathname (repository-path) egg ".setup-info")
     750    read))
     751
     752(define (create-temporary-directory)
     753  (let ((dir (or (getenv "TMPDIR") (getenv "TEMP") (getenv "TMP") "/tmp")))
     754    (let loop ()
     755      (let* ((n (##sys#fudge 16))       ; current milliseconds
     756             (pn (make-pathname dir (string-append "setup-" (number->string n 16)) "tmp")))
     757        (cond ((file-exists? pn) (loop))
     758              (else (create-directory pn) pn))))))
     759
     760(define (remove-directory dir #!optional (strict #t))
     761  (cond ((not (file-exists? dir))
     762         (if strict
     763             (error 'remove-directory "can not remove - directory not found" dir)
     764             #f))
     765        (*sudo*
     766         (system* "sudo rm -fr '~a'" dir))
     767        (else
     768         (let walk ((dir dir))
     769           (let ((files (directory dir #t)))
     770             (for-each
     771              (lambda (f)
     772                (unless (or (string=? "." f) (string=? ".." f))
     773                  (let ((p (make-pathname dir f)))
     774                    (if (directory? p)
     775                        (walk p)
     776                        (delete-file p)))))
     777              files)
     778             (delete-directory dir)))) ))
     779
     780(define (remove-extension egg)
     781  (and-let* ((files (assq 'files (read-info egg))))
     782    (for-each remove-file* (cdr files)))
     783  (remove-file* (make-pathname (repository-path) egg "setup-info")))
     784
    750785)
Note: See TracChangeset for help on using the changeset viewer.