mirror of https://codeberg.org/glenneth/stash.git
135 lines
5.1 KiB
Scheme
135 lines
5.1 KiB
Scheme
;;; stash.scm --- A Guile script for moving directories and creating symlinks with conflict resolution
|
|
;;;
|
|
;;; Author: Glenn Thompson <glenn@kirstol.org>
|
|
;;; Version: 0.1.0-alpha.1
|
|
;;; Created: 2024-12-03
|
|
;;; Compatibility: Guile 3.0.9
|
|
;;; Keywords: symlink, file management, conflict resolution, backup
|
|
;;;
|
|
;;; Commentary:
|
|
;;;
|
|
;;; Stash is a command-line utility written in Guile Scheme designed to facilitate the movement of directories and
|
|
;;; creation of symbolic links (symlinks) for files and directories. It allows users to specify a source directory
|
|
;;; and a target directory where the symlink should be created. The utility handles potential conflicts with existing
|
|
;;; files or directories at the target location, offering users the choice to overwrite, back up, or skip the creation of new symlinks.
|
|
;;;
|
|
;;; Main Features:
|
|
;;; - Command-line argument parsing for specifying source and target paths.
|
|
;;; - Conflict detection with interactive user resolution options (overwrite, backup, skip, or cancel).
|
|
;;; - Moving directories and creating symlinks.
|
|
;;; - Simple and interactive user interface for easy use.
|
|
;;;
|
|
;;; Usage:
|
|
;;;
|
|
;;; guile -L . stash.scm --target=<target-dir> --source=<source-dir>
|
|
;;;
|
|
;;; Replace <target-dir> with the directory where you want the symlink to be created,
|
|
;;; and <source-dir> with the path to the source directory.
|
|
;;;
|
|
;;; License:
|
|
;;;
|
|
;;; This project is licensed under the GNU General Public License v3.
|
|
;;;
|
|
|
|
;;; CODE
|
|
|
|
(define-module (stash)
|
|
#:use-module (ice-9 getopt-long)
|
|
#:use-module (stash help)
|
|
#:use-module (stash colors)
|
|
#:use-module (stash log)
|
|
#:use-module (stash paths)
|
|
#:use-module (stash conflict)
|
|
#:use-module (stash file-ops)
|
|
#:use-module (stash package)
|
|
#:use-module (stash tree)
|
|
#:use-module (srfi srfi-1)
|
|
#:use-module (srfi srfi-19))
|
|
|
|
;;; Command-line options
|
|
(define %options
|
|
'((target (value #t) (single-char #\t))
|
|
(source (value #t) (single-char #\s))
|
|
(help (value #f) (single-char #\h))
|
|
(version (value #f) (single-char #\v))
|
|
(no-folding (value #f) (single-char #\n))
|
|
(simulate (value #f) (single-char #\S))
|
|
(adopt (value #f) (single-char #\a))
|
|
(restow (value #f) (single-char #\R))
|
|
(delete (value #f) (single-char #\D))))
|
|
|
|
;;; Function to handle dot directory stashing
|
|
(define (handle-dot-stash current-dir)
|
|
"Handle stashing when using the '.' syntax. Uses parent as stow dir and $HOME as target."
|
|
(let* ((pkg-dir (canonicalize-path current-dir))
|
|
(stow-dir (dirname pkg-dir))
|
|
(home-dir (getenv "HOME")))
|
|
(format #t "pkg-dir: ~a~%" pkg-dir)
|
|
(format #t "stow-dir: ~a~%" stow-dir)
|
|
(format #t "home-dir: ~a~%" home-dir)
|
|
(values pkg-dir stow-dir home-dir)))
|
|
|
|
;;; Version function
|
|
(define (display-version)
|
|
"Display the current version of the program."
|
|
(newline)
|
|
(display "Stash version 0.1.0-alpha.1\n")
|
|
(exit 0))
|
|
|
|
;;; Helper function to check for version flag and display version
|
|
(define (check-for-version args)
|
|
"Check if --version or -v is in the arguments list."
|
|
(if (or (member "--version" args)
|
|
(member "-v" args))
|
|
(display-version)))
|
|
|
|
;;; Main function to handle stowing operations
|
|
(define (handle-stow package options)
|
|
(let* ((tree (analyze-tree package))
|
|
(simulate? (assoc-ref options 'simulate))
|
|
(no-folding? (assoc-ref options 'no-folding)))
|
|
(plan-operations tree package)))
|
|
|
|
;;; Main entry point
|
|
(define (main args)
|
|
"Main function to parse arguments and execute the program."
|
|
(setenv "GUILE_AUTO_COMPILE" "0")
|
|
|
|
(let* ((options (getopt-long args %options))
|
|
(source-dir (assoc-ref options 'source))
|
|
(target-dir (assoc-ref options 'target))
|
|
(non-option-args (option-ref options '() '())))
|
|
|
|
(cond
|
|
((assoc-ref options 'help) (display-help))
|
|
((assoc-ref options 'version) (display-version))
|
|
;; Handle "stash ." syntax
|
|
((and (= (length non-option-args) 1)
|
|
(string=? (car non-option-args) "."))
|
|
(call-with-values
|
|
(lambda () (handle-dot-stash (getcwd)))
|
|
(lambda (pkg-dir stow-dir home-dir)
|
|
(let ((package (make-package
|
|
(basename pkg-dir)
|
|
pkg-dir
|
|
home-dir
|
|
(read-ignore-patterns pkg-dir))))
|
|
(handle-stow package options)))))
|
|
;; Handle traditional --source --target syntax
|
|
((not (and target-dir source-dir))
|
|
(display (color-message "Error: Either use '.' in a package directory or provide both --source and --target arguments.\n" red-text))
|
|
(display (color-message "Usage: stash.scm [--target <target-dir> --source <source-dir>] | [.]\n" yellow-text))
|
|
(exit 1))
|
|
(else
|
|
(let* ((expanded-source (expand-home source-dir))
|
|
(expanded-target (expand-home target-dir))
|
|
(package (make-package
|
|
(basename expanded-source)
|
|
expanded-source
|
|
expanded-target
|
|
(read-ignore-patterns expanded-source))))
|
|
(handle-stow package options))))))
|
|
|
|
;; Entry point for stash
|
|
(main (command-line))
|