Changeset 17976 in project


Ignore:
Timestamp:
05/01/10 00:45:36 (9 years ago)
Author:
zbigniew
Message:

chicken-doc, chicken-doc-admin: bugfix for repo creation

Location:
release/4
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/4/chicken-doc-admin/trunk/chicken-doc-admin-cmd.scm

    r17827 r17976  
    3232           (create-repository!))
    3333          ((string=? o "-D")
     34           (verify-repository)
    3435           (destroy-repository!))
    3536          (else
    36            (unless (verify-repository)
     37           (unless (verify-repository)        ; WARNING: now throws an error
    3738             (fprintf (current-error-port)
    3839                      "No repository found at ~a\nUse -i to initialize\n" (repository-base))
  • release/4/chicken-doc-admin/trunk/chicken-doc-admin.scm

    r17975 r17976  
    119119
    120120(define (create-repository!)
    121   ;; FIXME: initialization should not occur if the version is wrong
    122   ;;   -- or, it should destroy the repository first
    123   (let ((r (current-repository)))
     121  (let ((r (make-repository-placeholder
     122             (locate-repository))))
    124123    (when (file-exists? (repository-magic r))
    125124      (error "Repository already exists at" (repository-base r)))
     125    (print "Creating repository at " (repository-base r) "...")
    126126    (create-directory (repository-base r))
    127127    (create-directory (repository-root r))
    128128    (with-output-to-file (repository-magic r)
    129       (lambda () (pp `((version . ,+repository-version+)))))))
     129      (lambda () (pp (repository-information r))))))
     130
    130131(define (describe-repository)
    131132;;   (print "Repository information:")
  • release/4/chicken-doc/trunk/chicken-doc.scm

    r17974 r17976  
    1919 path->keys keys->pathname field-filename keys+field->pathname key->id
    2020 make-id-cache id-cache-filename
     21 make-repository-placeholder
    2122;; Node API
    2223 lookup-node
     
    469470    (locate-repository))))
    470471
     472;; Internal; make a fake repository object containing
     473;; all the fields a valid object would have.
     474(define (make-repository-placeholder base)
     475  (make-repository base
     476                   (make-pathname base "root")
     477                   (make-pathname base ".chicken-doc-repo")
     478                   `((version . ,+repository-version+))
     479                   (make-invalid-id-cache base)))
     480
    471481;; Open repository and return new repository object or
    472482;; throw error if nonexistent or format failure.
    473483(define (open-repository base)
    474   (let ((magic (make-pathname base ".chicken-doc-repo")))
    475     (if (file-exists? magic)
    476         (let ((info (with-input-from-file magic read)))
    477           (let ((version (or (alist-ref 'version info) 0)))
    478             (cond ((= version +repository-version+)
    479                    (let ((r (make-repository base
    480                                              (make-pathname base "root")
    481                                              magic
    482                                              info
    483                                              (make-invalid-id-cache base))))
    484                      (set-finalizer! r close-repository)
    485                      r))
    486                   (else (error "Invalid repo version number ~a, expected ~a\n"
    487                                 version +repository-version+)))))
    488         (error "No chicken-doc repository found at " base))))
     484  (let ((rp (make-repository-placeholder base)))
     485    (let ((magic (repository-magic rp)))
     486      (if (file-exists? magic)
     487          (let ((info (with-input-from-file magic read)))
     488            (let ((version (or (alist-ref 'version info) 0)))
     489              (cond ((= version +repository-version+)
     490                     (let ((r (make-repository (repository-base rp)
     491                                               (repository-root rp)
     492                                               magic
     493                                               info
     494                                               (repository-id-cache rp))))
     495                       (set-finalizer! r close-repository)
     496                       r))
     497                    (else (error "Invalid repo version number ~a, expected ~a\n"
     498                                 version +repository-version+)))))
     499          (error "No chicken-doc repository found at " base)))))
    489500(define (close-repository r)
    490501  (void))
Note: See TracChangeset for help on using the changeset viewer.