1#lang racket/base 2(require racket/cmdline 3 racket/format 4 racket/path 5 racket/file) 6 7;; Adjust the configuration to consult a catalog that is 8;; expected to map some packages to directory links. 9 10;; Used by the top-level Makefile in the main Racket repository. 11 12(define config-dir-path (build-path "racket" "etc")) 13(define config-file-path (build-path config-dir-path "config.rktd")) 14 15(define catalog-relative-path (build-path 'up "share" "pkgs-catalog")) 16(define catalog-relative-path-str (path->string catalog-relative-path)) 17 18(define-values (default-src-catalog src-catalog) 19 (command-line 20 #:args 21 (default-src-catalog src-catalog) 22 (values default-src-catalog src-catalog))) 23 24(define src-catalog-is-default? 25 (equal? src-catalog default-src-catalog)) 26 27(when (file-exists? config-file-path) 28 (call-with-input-file* 29 config-file-path 30 (lambda (i) 31 (define r (read i)) 32 (define l (hash-ref r 'catalogs #f)) 33 (define starts-as-expected? 34 (and (list? l) 35 ((length l) . >= . 1) 36 (equal? (car l) catalog-relative-path-str))) 37 (define has-src-catalog? 38 (or (and src-catalog-is-default? 39 (member #f l)) 40 (member src-catalog l))) 41 (unless (and starts-as-expected? 42 has-src-catalog?) 43 (error 'pkgs-catalog 44 (~a "config file exists, but with a mismatched `catalogs';\n" 45 " the existing configuration does not ~a\n" 46 " config file: ~a\n" 47 " expected ~acatalog: ~s\n" 48 " possible solution: delete the config file") 49 (if (not starts-as-expected?) 50 "start as expected" 51 "include the specified catalog") 52 config-file-path 53 (if (not starts-as-expected?) 54 "initial " 55 "") 56 (if (not starts-as-expected?) 57 catalog-relative-path-str 58 src-catalog)))))) 59 60(unless (file-exists? config-file-path) 61 (printf "Writing ~a\n" config-file-path) 62 (let-values ([(base name dir?) (split-path config-file-path)]) 63 (when (path? base) (make-directory* base))) 64 (call-with-output-file* 65 config-file-path 66 (lambda (o) 67 (write (hash 'catalogs 68 (cons catalog-relative-path-str 69 (append 70 (if src-catalog-is-default? 71 '() 72 (list src-catalog)) 73 (list #f))) 74 'installation-name 75 "development" 76 'default-scope 77 "installation" 78 'interactive-file 79 'racket/interactive 80 'gui-interactive-file 81 'racket/gui/interactive) 82 o) 83 (newline o)))) 84