From b57ac15729899892387cf04efed3aca5e2f43ae8 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Sun, 14 Jul 2024 21:28:33 -0500 Subject: Add dots.scm --- README | 31 -------------- README.md | 4 ++ dots.scm | 139 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 143 insertions(+), 31 deletions(-) delete mode 100644 README create mode 100644 README.md create mode 100755 dots.scm diff --git a/README b/README deleted file mode 100644 index 5c229a7..0000000 --- a/README +++ /dev/null @@ -1,31 +0,0 @@ -My dotfiles -there are many like them -but these ones are mine - ----------- -Installing ----------- - -- ./dots.sh - -see ./dots.sh -h for more details - -I don't remember what -d means. - ------------ -What's here ------------ - -- bash / shell stuff -- emacs -- x stuff -- various other repl type stuff - ------- -TO ADD ------- - -- i3 config -- msmtp config (must remove PII) -- keepassxc ?? (can it do the two part config thing?) -- ... ? \ No newline at end of file diff --git a/README.md b/README.md new file mode 100644 index 0000000..6917265 --- /dev/null +++ b/README.md @@ -0,0 +1,4 @@ +# dots by acdw + +these are my dotfiles. +there are many like them but these ones is mine diff --git a/dots.scm b/dots.scm new file mode 100755 index 0000000..e22e7f8 --- /dev/null +++ b/dots.scm @@ -0,0 +1,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)) -- cgit 1.4.1-21-gabe81