From 9613bcd1546c6acd3ef75bdcf4dc014644694d74 Mon Sep 17 00:00:00 2001 From: Glenn Thompson Date: Sun, 28 Sep 2025 12:10:01 +0300 Subject: [PATCH] feat: Add enhanced stash with GNU Stow-like functionality - Add deploy mode (-d) for batch deployment from dotfiles repo - Add dot syntax support (stash .) for reverse symlinking - Add interactive mode improvements - Add package-specific deployment (stash package-name) - Maintain compatibility with original stash functionality - Work around module loading issues with direct module loading - Enhanced help and version information --- stash-enhanced.scm | 258 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 258 insertions(+) create mode 100755 stash-enhanced.scm diff --git a/stash-enhanced.scm b/stash-enhanced.scm new file mode 100755 index 0000000..ff201c1 --- /dev/null +++ b/stash-enhanced.scm @@ -0,0 +1,258 @@ +#!/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)))