diff options
| -rw-r--r-- | .gitignore | 8 | ||||
| -rw-r--r-- | Makefile | 2 | ||||
| -rw-r--r-- | README.org | 8 | ||||
| -rwxr-xr-x | bootstrap | 3 | ||||
| -rw-r--r-- | configure.ac | 8 | ||||
| -rw-r--r-- | dotfiles.scm | 111 | ||||
| -rw-r--r-- | install.in | 28 | ||||
| -rwxr-xr-x | install.scm | 92 | ||||
| -rw-r--r-- | package.scm | 22 |
9 files changed, 183 insertions, 99 deletions
@@ -1 +1,7 @@ -*~
\ No newline at end of file +*~ +/aclocal.m4 +/autom4te.cache/ +/config.log +/config.status +/configure +/install @@ -1,4 +1,4 @@ # This makefile might be more useful eventually. install: - ./install.scm + ./install @@ -1,11 +1,9 @@ * Dave's Dotfiles - Because all of the cool kids version control their dotfiles. - - Perhaps you are interested in my Emacs configuration. That has its - own repository. [[https://github.com/davexunit/.emacs.d][Check it out.]] + Because all of the cool kids version control their dotfiles, but + only the coolest kids write their own install script in Scheme. ** Installing The dotfiles are installed by creating symlinks from the =dotfiles/= directory to the current user's home directory. - To install, just run =make install=. + To install, just run =./bootstrap && ./configure && make install=. diff --git a/bootstrap b/bootstrap new file mode 100755 index 0000000..4a4af27 --- /dev/null +++ b/bootstrap @@ -0,0 +1,3 @@ +#!/bin/sh + +autoreconf -vif
\ No newline at end of file diff --git a/configure.ac b/configure.ac new file mode 100644 index 0000000..a1afa14 --- /dev/null +++ b/configure.ac @@ -0,0 +1,8 @@ +dnl -*- Autoconf -*- + +AC_INIT(dotfiles, 0) +AC_CONFIG_FILES([install], [chmod +x install]) + +GUILE_PROGS([2.0.9]) + +AC_OUTPUT diff --git a/dotfiles.scm b/dotfiles.scm new file mode 100644 index 0000000..2553454 --- /dev/null +++ b/dotfiles.scm @@ -0,0 +1,111 @@ +;;; Copyright © 2015 David Thompson <davet@gnu.org> +;;; +;;; This program is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU General Public License as +;;; published by the Free Software Foundation; either version 3 of the +;;; License, or (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program. If not, see +;;; <http://www.gnu.org/licenses/>. + +(define-module (dotfiles) + #:use-module (ice-9 ftw) + #:use-module (ice-9 i18n) + #:use-module (ice-9 match) + #:use-module (ice-9 regex) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-26) + #:export (install-dotfiles)) + +(define (recursive-scandir dir) + "Return a list of all the file names in DIR, recursively." + (define (components file) + (string-split file #\/)) + + (define suffix + (let ((prefix-length (length (components dir)))) + (lambda (file) + (string-join (drop (components file) prefix-length) "/")))) + + (define enter? (const #t)) + + ;; Ignore the backup files that Emacs makes. + (define ignore? + (let ((patterns (map make-regexp '("~$" "^\\.#" "^#")))) + (lambda (file) + (let ((base (basename file))) + (any (cut regexp-exec <> base) patterns))))) + + (define (leaf name stat result) + (if (ignore? name) + result + (cons (suffix name) result))) + + ;; No-op + (define (down name stat result) result) + (define (up name stat result) result) + (define (skip name stat result) result) + (define (error name stat errno result) result) + + (let-values (((files discard) + (file-system-fold enter? leaf down up skip error '() dir))) + (sort files string-locale<?))) + +(define (mkdir-p dir) + "Create directory DIR and all its ancestors." + (define absolute? + (string-prefix? "/" dir)) + + (define not-slash + (char-set-complement (char-set #\/))) + + (let loop ((components (string-tokenize dir not-slash)) + (root (if absolute? + "" + "."))) + (match components + ((head tail ...) + (let ((path (string-append root "/" head))) + (catch 'system-error + (lambda () + (mkdir path) + (loop tail path)) + (lambda args + (if (= EEXIST (system-error-errno args)) + (loop tail path) + (apply throw args)))))) + (() #t)))) + +(define (symlink? file) + "Return #t if FILE is a symbolic link." + (eq? (stat:type (lstat file)) 'symlink)) + +(define (already-linked? src-file dest-file) + "Return #t if SRC-FILE is a symbolic link to DEST-FILE." + (and (symlink? dest-file) + (string=? (readlink dest-file) src-file))) + +(define (install-dotfiles src-dir dest-dir) + "Symlink the dotfiles in SRC-DIR to DEST-DIR." + + (define (install-dotfile file) + (let ((src-file (string-append src-dir "/" file)) + (dest-file (string-append dest-dir "/" file))) + (cond + ((not (file-exists? dest-file)) + (format #t "~a → ~a~%" file dest-file) + (mkdir-p (dirname dest-file)) + (symlink src-file dest-file)) + ((already-linked? src-file dest-file) + (format #t "~a already installed~%" file)) + (else + (error "destination file already exists: " dest-file))))) + + (for-each install-dotfile (recursive-scandir src-dir))) diff --git a/install.in b/install.in new file mode 100644 index 0000000..ae27027 --- /dev/null +++ b/install.in @@ -0,0 +1,28 @@ +#!@GUILE@ --no-auto-compile +-*- scheme -*- +!# + +;;; Copyright © 2015 David Thompson <davet@gnu.org> +;;; +;;; This program is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU General Public License as +;;; published by the Free Software Foundation; either version 3 of the +;;; License, or (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program. If not, see +;;; <http://www.gnu.org/licenses/>. + +(define %abs-top-srcdir "@abs_top_srcdir@") + +(set! %load-path (cons %abs-top-srcdir %load-path)) + +(use-modules (dotfiles)) + +(install-dotfiles (string-append %abs-top-srcdir "/dotfiles") + (getenv "HOME")) diff --git a/install.scm b/install.scm deleted file mode 100755 index 7922a48..0000000 --- a/install.scm +++ /dev/null @@ -1,92 +0,0 @@ -#!/usr/bin/guile --no-auto-compile -!# - -(use-modules (ice-9 ftw) - (ice-9 i18n) - (ice-9 match) - (srfi srfi-1) - (srfi srfi-11) - (srfi srfi-26)) - -(define (recursive-scandir dir) - "Return a list of all the file names in DIR, recursively." - (define (components file) - (string-split file #\/)) - - (define suffix - (let ((prefix-length (length (components dir)))) - (lambda (file) - (string-join (drop (components file) prefix-length) "/")))) - - (define enter? (const #t)) - - (define (leaf name stat result) - (cons (suffix name) result)) - - ;; No-op - (define (down name stat result) result) - (define (up name stat result) result) - (define (skip name stat result) result) - (define (error name stat errno result) result) - - (let-values (((files discard) - (file-system-fold enter? leaf down up skip error '() dir))) - (sort files string-locale<?))) - -(define (mkdir-p dir) - "Create directory DIR and all its ancestors." - (define absolute? - (string-prefix? "/" dir)) - - (define not-slash - (char-set-complement (char-set #\/))) - - (let loop ((components (string-tokenize dir not-slash)) - (root (if absolute? - "" - "."))) - (match components - ((head tail ...) - (let ((path (string-append root "/" head))) - (catch 'system-error - (lambda () - (mkdir path) - (loop tail path)) - (lambda args - (if (= EEXIST (system-error-errno args)) - (loop tail path) - (apply throw args)))))) - (() #t)))) - -(define (symlink? file) - "Return #t if FILE is a symbolic link." - (eq? (stat:type (lstat file)) 'symlink)) - -(define (already-linked? src-file dest-file) - "Return #t if SRC-FILE is a symbolic link to DEST-FILE." - (and (symlink? dest-file) - (string=? (readlink dest-file) src-file))) - -(define %home (getenv "HOME")) - -(define %dotfiles-dir - (string-append (getcwd) "/dotfiles")) - -(define (install-dotfile file) - "Create a symlink to FILE in the current user's home directory." - (let ((src-file (string-append %dotfiles-dir "/" file)) - (dest-file (string-append %home "/" file))) - (cond - ((not (file-exists? dest-file)) - (format #t "~a → ~a~%" file dest-file) - (mkdir-p (dirname dest-file)) - (symlink src-file dest-file)) - ((already-linked? src-file dest-file) - (format #t "~a already installed~%" file)) - (else - (error "destination file already exists: " dest-file))))) - -(define %dotfiles - (recursive-scandir "dotfiles")) - -(for-each install-dotfile %dotfiles) diff --git a/package.scm b/package.scm new file mode 100644 index 0000000..66722f4 --- /dev/null +++ b/package.scm @@ -0,0 +1,22 @@ +(use-modules (guix packages) + (guix licenses) + (guix build-system trivial) + (gnu packages base) + (gnu packages autotools) + (gnu packages guile)) + +(package + (name "dotfiles") + (version "0") + (source #f) + (build-system trivial-build-system) + (native-inputs + `(("make" ,gnu-make) + ("autoconf" ,autoconf) + ("automake" ,automake))) + (inputs + `(("guile" ,guile-2.0))) + (synopsis "Dave's dotfiles") + (description "All of my glorious dotfiles.") + (home-page "https://git.dthompson.us/dotfiles.git") + (license gpl3+)) |