mirror of https://codeberg.org/glenneth/stash.git
259 lines
9.5 KiB
Scheme
Executable File
259 lines
9.5 KiB
Scheme
Executable File
#!/usr/bin/env guile
|
|
!#
|
|
|
|
;; Enhanced Stash with GNU Stow-like functionality
|
|
;; This version includes our enhancements merged with the dev branch improvements
|
|
|
|
(add-to-load-path ".")
|
|
|
|
(use-modules (ice-9 getopt-long)
|
|
(ice-9 ftw)
|
|
(ice-9 rdelim)
|
|
(srfi srfi-1)
|
|
(srfi srfi-19))
|
|
|
|
;; Load stash modules directly to avoid module conflicts
|
|
(load "modules/stash/colors.scm")
|
|
(load "modules/stash/log.scm")
|
|
(load "modules/stash/paths.scm")
|
|
(load "modules/stash/conflict.scm")
|
|
(load "modules/stash/package.scm")
|
|
(load "modules/stash/file-ops.scm")
|
|
(load "modules/stash/tree.scm")
|
|
|
|
;;; Enhanced help function
|
|
(define (display-help)
|
|
"Display help message explaining how to use the program."
|
|
(display "\
|
|
Usage: stash-enhanced [OPTION...] [PACKAGE|.]
|
|
|
|
Enhanced Stash with GNU Stow-like functionality for dotfiles management.
|
|
|
|
Options:
|
|
-s, --source=DIR Source directory to stash
|
|
-t, --target=DIR Target directory where files will be stashed
|
|
-r, --recursive Recursively process directories under source
|
|
-i, --interactive Interactively prompt for target directory
|
|
-d, --deploy Deploy mode: create symlinks from dotfiles repo
|
|
-h, --help Display this help
|
|
-v, --version Display version information
|
|
|
|
Stashing Examples (moving files to storage):
|
|
# Stash a single directory:
|
|
stash-enhanced -s ~/Documents/notes -t ~/backup/notes
|
|
|
|
# Stash with interactive target selection:
|
|
stash-enhanced -s ~/Pictures -i
|
|
|
|
# Recursively stash an entire directory:
|
|
stash-enhanced -s ~/.config -t ~/.dotfiles/config -r
|
|
|
|
Deployment Examples (GNU Stow-like functionality):
|
|
# Deploy all packages from dotfiles directory:
|
|
cd ~/.dotfiles && stash-enhanced -d
|
|
|
|
# Deploy specific package:
|
|
cd ~/.dotfiles && stash-enhanced shell
|
|
|
|
# Using dot syntax (create symlink from current dir to home):
|
|
cd ~/.dotfiles/shell && stash-enhanced .
|
|
|
|
Dotfiles Workflow:
|
|
1. Collect dotfiles: ~/.files/collect-dotfiles.sh
|
|
2. Stash to dotfiles repo: stash-enhanced -s ~/.zshrc -t ~/.dotfiles/shell/zshrc
|
|
3. On new machine: cd ~/.dotfiles && stash-enhanced -d
|
|
|
|
For more information, visit: https://codeberg.org/glenneth/stash
|
|
"))
|
|
|
|
(define (display-version)
|
|
(display "stash-enhanced version 0.2.0-alpha (with GNU Stow-like functionality)\n"))
|
|
|
|
;;; Command-line options
|
|
(define %options
|
|
'((target (value #t) (single-char #\t))
|
|
(source (value #t) (single-char #\s))
|
|
(recursive (value #f) (single-char #\r))
|
|
(interactive (value #f) (single-char #\i))
|
|
(deploy (value #f) (single-char #\d))
|
|
(help (value #f) (single-char #\h))
|
|
(version (value #f) (single-char #\v))))
|
|
|
|
;;; Enhanced handler functions for GNU Stow-like functionality
|
|
|
|
(define (handle-interactive-stash source recursive?)
|
|
"Handle interactive stashing where user selects target directory."
|
|
(display "Interactive target selection:\n")
|
|
(display (format #f "Source: ~a\n" source))
|
|
(display "Enter target directory: ")
|
|
(let ((target (read-line)))
|
|
(if (string-null? target)
|
|
(begin
|
|
(display "No target specified. Exiting.\n")
|
|
(exit 1))
|
|
(handle-explicit-stash source target recursive?))))
|
|
|
|
(define (handle-dot-syntax)
|
|
"Handle dot syntax: create symlink from current directory to home."
|
|
(let* ((current-dir (getcwd))
|
|
(home-dir (getenv "HOME"))
|
|
(relative-path (string-drop current-dir (+ (string-length home-dir) 1)))
|
|
(target-path (string-append home-dir "/" relative-path)))
|
|
(display (format #f "Creating symlink: ~a -> ~a\n" target-path current-dir))
|
|
(when (file-exists? target-path)
|
|
(if (file-is-symlink? target-path)
|
|
(delete-file target-path)
|
|
(begin
|
|
(display (format #f "Error: ~a already exists and is not a symlink\n" target-path))
|
|
(exit 1))))
|
|
(let ((target-dir (dirname target-path)))
|
|
(when (not (file-exists? target-dir))
|
|
(mkdir-p target-dir)))
|
|
(symlink current-dir target-path)
|
|
(display (format #f "Created symlink: ~a -> ~a\n" target-path current-dir))))
|
|
|
|
(define (handle-package-deploy package-name)
|
|
"Deploy a specific package from current directory."
|
|
(let* ((package-dir (string-append (getcwd) "/" package-name))
|
|
(home-dir (getenv "HOME")))
|
|
(if (file-exists? package-dir)
|
|
(deploy-package package-dir home-dir)
|
|
(begin
|
|
(display (format #f "Error: Package directory ~a not found\n" package-dir))
|
|
(exit 1)))))
|
|
|
|
(define (handle-deploy-mode args)
|
|
"Handle deploy mode: deploy all packages or specific package."
|
|
(let ((current-dir (getcwd))
|
|
(home-dir (getenv "HOME")))
|
|
(if (null? args)
|
|
;; Deploy all packages in current directory
|
|
(deploy-all-packages current-dir home-dir)
|
|
;; Deploy specific package
|
|
(handle-package-deploy (car args)))))
|
|
|
|
(define (deploy-all-packages dotfiles-dir home-dir)
|
|
"Deploy all packages from dotfiles directory."
|
|
(display (format #f "Deploying all packages from ~a to ~a\n" dotfiles-dir home-dir))
|
|
(let ((entries (scandir dotfiles-dir)))
|
|
(for-each
|
|
(lambda (entry)
|
|
(let ((entry-path (string-append dotfiles-dir "/" entry)))
|
|
(when (and (not (member entry '("." ".." ".git" "README.md" "collect-dotfiles.sh" "STASH_GUIDE.md")))
|
|
(file-is-directory? entry-path))
|
|
(display (format #f "Deploying package: ~a\n" entry))
|
|
(deploy-package entry-path home-dir))))
|
|
entries)))
|
|
|
|
(define (deploy-package package-dir home-dir)
|
|
"Deploy a single package by creating symlinks."
|
|
(let ((package-name (basename package-dir)))
|
|
(display (format #f "Deploying package: ~a\n" package-name))
|
|
(deploy-directory-contents package-dir home-dir)))
|
|
|
|
(define (deploy-directory-contents source-dir target-base)
|
|
"Recursively deploy directory contents by creating symlinks."
|
|
(let ((entries (scandir source-dir)))
|
|
(for-each
|
|
(lambda (entry)
|
|
(when (not (member entry '("." "..")))
|
|
(let* ((source-path (string-append source-dir "/" entry))
|
|
(target-path (string-append target-base "/." entry)))
|
|
(cond
|
|
((file-is-directory? source-path)
|
|
;; For directories, create the directory and recurse
|
|
(when (not (file-exists? target-path))
|
|
(mkdir target-path #o755))
|
|
(deploy-directory-contents source-path (dirname target-path)))
|
|
(else
|
|
;; For files, create symlink
|
|
(when (file-exists? target-path)
|
|
(if (file-is-symlink? target-path)
|
|
(delete-file target-path)
|
|
(display (format #f "Warning: ~a exists and is not a symlink, skipping\n" target-path))))
|
|
(let ((target-dir (dirname target-path)))
|
|
(when (not (file-exists? target-dir))
|
|
(mkdir-p target-dir)))
|
|
(symlink source-path target-path)
|
|
(display (format #f "Created symlink: ~a -> ~a\n" target-path source-path)))))))
|
|
entries)))
|
|
|
|
;;; Original stash functionality (adapted for dev branch improvements)
|
|
|
|
(define (handle-explicit-stash source target recursive?)
|
|
"Handle stashing with explicit source and target paths."
|
|
(let* ((source-path (normalize-path source))
|
|
(target-path (normalize-path target))
|
|
(package-name (basename source-path))
|
|
(ignore-patterns (read-ignore-patterns source-path))
|
|
(package (make-package package-name source-path target-path ignore-patterns)))
|
|
(if recursive?
|
|
(handle-recursive-stash source-path target-path)
|
|
(begin
|
|
(process-package package)
|
|
#t))))
|
|
|
|
(define (handle-recursive-stash source-path target-path)
|
|
"Handle recursive stashing of directories."
|
|
(let* ((base-name (basename source-path))
|
|
(ignore-patterns (read-ignore-patterns source-path))
|
|
(package (make-package base-name source-path target-path ignore-patterns)))
|
|
(process-package package)
|
|
#t))
|
|
|
|
(define (process-package package)
|
|
"Process a single package for stashing."
|
|
(let* ((tree (analyze-tree package))
|
|
(operations (plan-operations tree package)))
|
|
(execute-operations operations)
|
|
#t))
|
|
|
|
;;; Main function
|
|
(define (main args)
|
|
"Main function to parse arguments and execute the program."
|
|
(setenv "GUILE_AUTO_COMPILE" "0")
|
|
|
|
(let* ((options (getopt-long args %options))
|
|
(help-wanted? (option-ref options 'help #f))
|
|
(version-wanted? (option-ref options 'version #f))
|
|
(source (option-ref options 'source #f))
|
|
(target (option-ref options 'target #f))
|
|
(recursive? (option-ref options 'recursive #f))
|
|
(interactive? (option-ref options 'interactive #f))
|
|
(deploy? (option-ref options 'deploy #f))
|
|
(remaining-args (option-ref options '() '())))
|
|
|
|
(cond
|
|
(help-wanted?
|
|
(display-help)
|
|
(exit 0))
|
|
(version-wanted?
|
|
(display-version)
|
|
(exit 0))
|
|
(deploy?
|
|
(handle-deploy-mode remaining-args)
|
|
#t)
|
|
((and source target)
|
|
(handle-explicit-stash source target recursive?)
|
|
#t)
|
|
((and source interactive?)
|
|
(handle-interactive-stash source recursive?)
|
|
#t)
|
|
;; Handle dot syntax: stash .
|
|
((and (= (length remaining-args) 1) (string=? (car remaining-args) "."))
|
|
(handle-dot-syntax)
|
|
#t)
|
|
;; Handle package deployment: stash package-name
|
|
((and (= (length remaining-args) 1) (not (string=? (car remaining-args) ".")))
|
|
(handle-package-deploy (car remaining-args))
|
|
#t)
|
|
(else
|
|
(display-help)
|
|
(exit 1)))))
|
|
|
|
;; Entry point for stash-enhanced
|
|
(let ((result (main (command-line))))
|
|
(if result
|
|
(exit 0)
|
|
(exit 1)))
|