blob: e22e7f8c485346b85539e54962c0ca494773a319 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
|
;;; dots/dots.scm --- dots management tool
;; by Case Duckworth
(import scheme (chicken base)
(chicken file)
(chicken file posix)
(chicken pathname)
(chicken process-context)
(chicken string))
(define QUIET (make-parameter #f))
(define NORUN (make-parameter #f))
(define FORCE (make-parameter #f))
(define DOTSD
(make-parameter
(let ((exec-dir (pathname-directory (executable-pathname))))
(if (and exec-dir (not (substring-index "csi" exec-dir)))
exec-dir
(pathname-directory (program-name))))))
(define usage-string
(string-append
"dots/dots: install dotfiles
Usage: dots/dots [-h] [-q] [-n] [-f] [-x] [-d] [-D DIR] [FILE...]
Flags:
-h Show this help and exit
-q Don't print what's happening
-n *Only* print what would happen
-f Force links with ln -f
-d Link from FILE *to* the dots dir.
Default: link from FILE to $HOME.
Options:
-D DIR
Define DIR as the dotfile-directory.
Default: The script's directory (" (DOTSD) ")
Parameters:
FILE File or directory to link.
"))
(define (getfiles files)
;; find all of the files in FILES, descending directories
(let loop ((files files)
(lst '()))
(if (null? files) (if (list? lst) lst (list lst))
(let ((this (car files)))
(if (or (substring-index "README" this) ; Ignore these files
(substring-index "dots" this))
(loop files lst)
;; Add the current file to the list recursively
(loop (cdr files)
(if (directory-exists? this)
(append (find-files this
test: (complement directory?))
lst)
(cons this lst))))))))
(define (mklink from to)
(let ((to-dir (pathname-directory to)))
(cond
((not (file-exists? from))
(die 3 "Cannot find" from))
((not (file-exists? to))
(echo "* ln" from to)
#;(file-link from to))
((and (FORCE) (file-exists? to))
(echo "* ln -f" from to)
#;(file-link from to))
(else (echo to "exists: skipping")))))
(define (homify files)
(for-each (lambda (f)
(mklink f (make-pathname
(get-environment-variable "HOME")
"" ; is this smart?
(string-intersperse
(receive (_ _ els) (decompose-directory f) els)
"/"))))
(getfiles files)))
(define (dotify files)
(for-each (lambda (f)
(mklink f (make-pathname
(DOTSD) (substring f (+ 1 (substring-index "." f))))))
(getfiles files)))
(define (main args)
(let loop ((action homify)
(args args))
(if (null? args)
(die 1 "Need at least one file argument")
(begin
(cond
((not (string=? "-" (substring (car args) 0 1))) ; End of flags
(action args)
(exit 0))
((or (string=? (car args) "-h")
(string=? (car args) "-help"))
(die 0 usage-string))
((or (string=? (car args) "-q")
(string=? (car args) "-quiet"))
(QUIET #t))
((or (string=? (car args) "-n")
(string=? (car args) "-norun"))
(NORUN #t))
((or (string=? (car args) "-f")
(string=? (car args) "-force"))
(FORCE #t))
((or (string=? (car args) "-d")
(string=? (car args) "-dotify"))
(set! action dotify))
((or (string=? (car args) "-D")
(string=? (car args) "-dotsdir"))
(when (null? (cdr args))
(die 4 "-D needs an argument"))
(DOTSD (cadr args))
(loop action (cddr args)))
(else (die 2 "Unknown argument: " (car args))))
(loop action (cdr args))))))
(define (echo . strs)
(unless (QUIET)
(parameterize ((current-output-port (current-error-port)))
(display (string-intersperse strs " "))
(newline))))
(define (die exit-code . message)
(cond-expand
((or compiling chicken-script)
(parameterize ((current-output-port (current-error-port)))
(display (string-intersperse message " "))
(newline)
(display usage-string)
(exit exit-code)))
(else (error message))))
(cond-expand
((or compiling chicken-script)
(main (command-line-arguments)))
(else))
|
