diff options
Diffstat (limited to 'gnu/home/services')
| -rw-r--r-- | gnu/home/services/dotfiles.scm | 117 | ||||
| -rw-r--r-- | gnu/home/services/symlink-manager.scm | 7 |
2 files changed, 124 insertions, 0 deletions
diff --git a/gnu/home/services/dotfiles.scm b/gnu/home/services/dotfiles.scm new file mode 100644 index 0000000000..6a740c42ce --- /dev/null +++ b/gnu/home/services/dotfiles.scm @@ -0,0 +1,117 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2024 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2024 Giacomo Leidi <goodoldpaul@autistici.org> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix 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. +;;; +;;; GNU Guix 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 GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (gnu home services dotfiles) + #:use-module (gnu home services) + #:use-module (gnu services) + #:autoload (guix build utils) (find-files) + #:use-module (guix gexp) + #:use-module (guix records) + #:use-module ((guix utils) #:select (current-source-directory)) + #:use-module (srfi srfi-1) + #:use-module (ice-9 ftw) + #:use-module (ice-9 regex) + #:export (home-dotfiles-service-type + home-dotfiles-configuration + home-dotfiles-configuration? + home-dotfiles-configuration-source-directory + home-dotfiles-configuration-directories + home-dotfiles-configuration-excluded)) + +(define %home-dotfiles-excluded + '(".*~" + ".*\\.swp" + "\\.git" + "\\.gitignore")) + +(define-record-type* <home-dotfiles-configuration> + home-dotfiles-configuration make-home-dotfiles-configuration + home-dotfiles-configuration? + (source-directory home-dotfiles-configuration-source-directory + (default (current-source-directory)) + (innate)) + (directories home-dotfiles-configuration-directories ;list of strings + (default '())) + (excluded home-dotfiles-configuration-excluded ;list of strings + (default %home-dotfiles-excluded))) + +(define (import-dotfiles directory files) + "Return a list of objects compatible with @code{home-files-service-type}'s +value. Each object is a pair where the first element is the relative path +of a file and the second is a gexp representing the file content. Objects are +generated by recursively visiting DIRECTORY and mapping its contents to the +user's home directory, excluding files that match any of the patterns in EXCLUDED." + (define (strip file) + (string-drop file (+ 1 (string-length directory)))) + + (define (format file) + ;; Remove from FILE characters that cannot be used in the store. + (string-append + "home-dotfiles-" + (string-map (lambda (chr) + (if (and (char-set-contains? char-set:ascii chr) + (char-set-contains? char-set:graphic chr) + (not (memv chr '(#\. #\/ #\space)))) + chr + #\-)) + file))) + + (map (lambda (file) + (let ((stripped (strip file))) + (list stripped + (local-file file (format stripped) + #:recursive? #t)))) + files)) + +(define (home-dotfiles-configuration->files config) + "Return a list of objects compatible with @code{home-files-service-type}'s +value, generated following GNU Stow's algorithm for each of the +directories in CONFIG, excluding files that match any of the patterns configured." + (define excluded + (home-dotfiles-configuration-excluded config)) + (define exclusion-rx + (make-regexp (string-append "^.*(" (string-join excluded "|") ")$"))) + + (define (directory-contents directory) + (find-files directory + (lambda (file stat) + (not (regexp-exec exclusion-rx + (basename file)))))) + + (define (resolve directory) + ;; Resolve DIRECTORY relative to the 'source-directory' field of CONFIG. + (if (string-prefix? "/" directory) + directory + (in-vicinity (home-dotfiles-configuration-source-directory config) + directory))) + + (append-map (lambda (directory) + (let* ((directory (resolve directory)) + (contents (directory-contents directory))) + (import-dotfiles directory contents))) + (home-dotfiles-configuration-directories config))) + +(define-public home-dotfiles-service-type + (service-type (name 'home-dotfiles) + (extensions + (list (service-extension home-files-service-type + home-dotfiles-configuration->files))) + (default-value (home-dotfiles-configuration)) + (description "Files that will be put in the user's home directory +following GNU Stow's algorithm, and further processed during activation."))) diff --git a/gnu/home/services/symlink-manager.scm b/gnu/home/services/symlink-manager.scm index e4c931fbee..560e03a839 100644 --- a/gnu/home/services/symlink-manager.scm +++ b/gnu/home/services/symlink-manager.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2021 Andrew Tropin <andrew@trop.in> ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> ;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2024 Nicolas Graves <ngraves@ngraves.fr> ;;; ;;; This file is part of GNU Guix. ;;; @@ -157,6 +158,12 @@ subdirectory from XDG_CONFIG_HOME to generate a target path." #t (G_ "Skipping ~a (not an empty directory)... done\n") directory)) + ;; This happens when the directory is a mounted device. + ((= EBUSY errno) + (format + #t + (G_ "Skipping ~a (underlying device is busy)... done\n") + directory)) ((= ENOENT errno) #t) ((= ENOTDIR errno) #t) (else |