glenn
/
stash
mirror of https://codeberg.org/glenneth/stash.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity
stash/stash.scm

1304 lines
60 KiB
Scheme
Raw Blame History

;; ;;; 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:
;; ;; Import necessary modules
;; (use-modules (ice-9 getopt-long)
;; (ice-9 popen)
;; (ice-9 rdelim)
;; (ice-9 format)
;; (srfi srfi-1)
;; (srfi srfi-19)) ;; Use for list handling and date-time formatting
;; ;;; ANSI Color Codes for terminal output
;; (define red-text "\x1b[31m")
;; (define yellow-text "\x1b[33m")
;; (define green-text "\x1b[32m")
;; (define reset-text "\x1b[0m")
;; ;;; Function to wrap messages in color
;; (define (color-message message color)
;; (string-append color message reset-text))
;; ;;; Helper function to get a formatted current time string
;; (define (current-timestamp)
;; "Return the current date and time as a formatted string."
;; (let* ((time (current-time))
;; (seconds (time-second time)))
;; (strftime "%Y-%m-%d-%H-%M-%S" (localtime seconds))))
;; ;;; Improved logging function with timestamp
;; (define (log-action message)
;; "Log an action with a timestamp to the stash.log file."
;; (let ((log-port (open-file "stash.log" "a"))) ;; Open file in append mode
;; (display (string-append "[" (current-timestamp) "] " message) log-port)
;; (newline log-port)
;; (close-port log-port))) ;; Close the port after writing
;; ;;; Expand ~ in paths to the full home directory path
;; (define (expand-home path)
;; "Expand ~ to the user's home directory."
;; (if (string-prefix? "~" path)
;; (string-append (getenv "HOME") (substring path 1))
;; path))
;; ;;; Helper function to back up a directory or symlink
;; (define (backup-path path)
;; "Back up a directory or symlink by renaming it with a timestamp."
;; (let ((backup-path (string-append path ".backup." (current-timestamp))))
;; (rename-file path backup-path)
;; (display (color-message (format #f "Backed up ~a to ~a\n" path backup-path) green-text))
;; (log-action (format #f "Backed up ~a to ~a" path backup-path))))
;; ;;; Function to handle command-line arguments
;; (define (parse-arguments args)
;; "Parse command-line arguments."
;; (let* ((opts (getopt-long args
;; '((target (value #t) (required? #t))
;; (source (value #t) (required? #t))))))
;; opts))
;; ;;; Helper function to quote shell arguments
;; (define (shell-quote-argument arg)
;; "Quote shell argument to handle spaces or special characters."
;; (if (string-contains arg " ")
;; (string-append "\"" (string-replace arg "\"" "\\\"") "\"")
;; arg))
;; ;;; Helper function to delete a directory recursively
;; (define (delete-directory path)
;; "Delete a directory recursively."
;; (if (file-is-directory? path)
;; (begin
;; (system (string-append "rm -rf " (shell-quote-argument path))) ;; Use rm -rf to delete recursively
;; (log-action (format #f "Deleted directory: ~a" path))) ;; Log the deletion
;; (display (color-message "Error: Path is not a directory.\n" red-text))))
;; ;;; Helper function to move source to target
;; (define (move-source-to-target source-dir target-dir)
;; "Move the entire source directory to the target directory."
;; (let* ((source-dir (expand-home source-dir))
;; (target-dir (expand-home target-dir))
;; (source-name (basename source-dir))
;; (target-source-dir (string-append target-dir "/" source-name)))
;; ;; Check if the target directory already exists
;; (if (file-exists? target-source-dir)
;; (begin
;; (display (color-message (format #f "Directory ~a already exists.\n" target-source-dir) yellow-text))
;; ;; Handle the conflict: overwrite, backup, or skip
;; (let ((choice (prompt-user-for-backup-action)))
;; (cond
;; ((eq? choice 'overwrite)
;; (delete-directory target-source-dir)
;; (rename-file source-dir target-source-dir)
;; (display (color-message (format #f "Overwriting directory ~a.\n" target-source-dir) green-text))
;; (log-action (format #f "Overwritten directory: ~a" target-source-dir)))
;; ((eq? choice 'backup)
;; (backup-path target-source-dir)
;; (rename-file source-dir target-source-dir)
;; (display (color-message (format #f "Moved ~a to ~a\n" source-dir target-source-dir) green-text))
;; (log-action (format #f "Moved ~a to ~a after backup" source-dir target-source-dir)))
;; ((eq? choice 'skip)
;; (display (color-message "Skipping move operation.\n" green-text))
;; (log-action (format #f "Skipped moving directory: ~a" target-source-dir)))
;; ((eq? choice 'cancel)
;; (display (color-message "Operation cancelled by user.\n" yellow-text))
;; (log-action "Operation cancelled by user.")
;; (exit 0)))))
;; ;; If the target directory doesn't exist, proceed with the move
;; (begin
;; (rename-file source-dir target-source-dir)
;; (display (color-message (format #f "Moved ~a to ~a\n" source-dir target-source-dir) green-text))
;; (log-action (format #f "Moved ~a to ~a" source-dir target-source-dir))))
;; target-source-dir)) ;; Return the path of the moved source directory
;; ;;; Helper function to create a symlink in the parent directory of the original source
;; (define (create-symlink-in-parent source-dir target-dir)
;; "Create a symlink in the parent directory of source-dir."
;; (let* ((parent-dir (expand-home (dirname source-dir))) ;; Ensure the parent path is expanded
;; (symlink-target (string-append parent-dir "/" (basename source-dir)))
;; (target-dir (expand-home target-dir))) ;; Ensure the target path is expanded
;; ;; Check if symlink already exists
;; (if (file-exists? symlink-target)
;; (handle-conflicts source-dir symlink-target) ;; Handle conflict if symlink or file exists
;; (begin
;; ;; Create the symlink if no conflict
;; (symlink target-dir symlink-target)
;; (display (color-message (format #f "Symlink created at ~a pointing to ~a\n" symlink-target target-dir) green-text))
;; (log-action (format #f "Symlink created at ~a pointing to ~a" symlink-target target-dir))))))
;; ;;; Conflict resolution handler with backup option
;; (define (prompt-user-for-backup-action)
;; "Prompt the user to decide how to handle a conflict: overwrite (o), backup (b), skip (s), or cancel (c)."
;; (display (color-message "A conflict was detected. Choose action - Overwrite (o), Backup (b), Skip (s), or Cancel (c): " yellow-text))
;; (let ((response (read-line)))
;; (cond
;; ((string-ci=? response "o") 'overwrite)
;; ((string-ci=? response "b") 'backup)
;; ((string-ci=? response "s") 'skip)
;; ((string-ci=? response "c") 'cancel)
;; (else
;; (display (color-message "Invalid input. Please try again.\n" red-text))
;; (prompt-user-for-backup-action)))))
;; ;;; Function to handle conflicts with symlinks and directories
;; (define (handle-conflicts source target)
;; "Handle conflicts when a symlink or file already exists at the target location."
;; (display (color-message (format #f "Conflict detected! A file or symlink already exists at ~a.\n" target) yellow-text))
;; (let ((choice (prompt-user-for-backup-action))) ;; Prompt for backup or overwrite
;; (cond
;; ((eq? choice 'overwrite)
;; (if (file-is-symlink? target)
;; (begin
;; (delete-file target)
;; (display (color-message "Removed the existing symbolic link.\n" green-text))
;; (log-action (format #f "Removed the existing symbolic link at ~a" target))
;; (create-symlink-in-parent source target))
;; (display (color-message "Error: Target is not a symbolic link.\n" red-text))))
;; ((eq? choice 'backup)
;; (backup-path target) ;; Backup the existing directory or symlink
;; (create-symlink-in-parent source target)) ;; After backup, create the new symlink
;; ((eq? choice 'skip)
;; (log-action (format #f "Skipped creating symlink at ~a" target))
;; (display (color-message "Keeping existing symbolic link.\n" green-text)))
;; ((eq? choice 'cancel)
;; (log-action "Operation cancelled by user.")
;; (display (color-message "Operation cancelled.\n" yellow-text))
;; (exit 0))
;; (else
;; (display (color-message "Invalid choice. Please try again.\n" red-text))
;; (handle-conflicts source target)))))
;; ;;; Main function to handle source and target operations
;; (define (handle-source-and-target source-dir target-dir)
;; "Move the source directory to the target and create a symlink in the parent directory."
;; (let ((target-source-dir (move-source-to-target source-dir target-dir))) ;; Move the directory
;; (create-symlink-in-parent source-dir target-source-dir))) ;; Create the symlink if no conflict
;; ;;; Main entry point
;; (define (main args)
;; "Main function to parse arguments and execute the program."
;; (setenv "GUILE_AUTO_COMPILE" "0") ;; Disable auto-compilation to improve performance
;; (let* ((options (parse-arguments args))
;; (target-dir (assoc-ref options 'target))
;; (source-dir (assoc-ref options 'source)))
;; (if (and target-dir source-dir)
;; (handle-source-and-target source-dir target-dir) ;; Handle the source move and symlink creation
;; (begin
;; (display (color-message "Error: Missing required arguments.\n" red-text))
;; (display (color-message "Usage: stash.scm --target=<target-dir> --source=<source-dir>\n" yellow-text))
;; (exit 1)))))
;; ;; Entry point for stash
;; (main (command-line))
;; ;;; 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:
;; ;; Import necessary modules
;; (use-modules (ice-9 getopt-long)
;; (ice-9 popen)
;; (ice-9 rdelim)
;; (ice-9 format)
;; (srfi srfi-1)
;; (srfi srfi-19)) ;; Use for list handling and date-time formatting
;; ;;; ANSI Color Codes for terminal output
;; (define red-text "\x1b[31m")
;; (define yellow-text "\x1b[33m")
;; (define green-text "\x1b[32m")
;; (define reset-text "\x1b[0m")
;; ;;; Function to wrap messages in color
;; (define (color-message message color)
;; (string-append color message reset-text))
;; ;;; Helper function to get a formatted current time string
;; (define (current-timestamp)
;; "Return the current date and time as a formatted string."
;; (let* ((time (current-time))
;; (seconds (time-second time)))
;; (strftime "%Y-%m-%d-%H-%M-%S" (localtime seconds))))
;; ;;; Improved logging function with timestamp
;; (define (log-action message)
;; "Log an action with a timestamp to the stash.log file."
;; (let ((log-port (open-file "stash.log" "a"))) ;; Open file in append mode
;; (display (string-append "[" (current-timestamp) "] " message) log-port)
;; (newline log-port)
;; (close-port log-port))) ;; Close the port after writing
;; ;;; Expand ~ in paths to the full home directory path
;; (define (expand-home path)
;; "Expand ~ to the user's home directory."
;; (if (string-prefix? "~" path)
;; (string-append (getenv "HOME") (substring path 1))
;; path))
;; ;;; Helper function to back up a directory or symlink
;; (define (backup-path path)
;; "Back up a directory or symlink by renaming it with a timestamp."
;; (let ((backup-path (string-append path ".backup." (current-timestamp))))
;; (rename-file path backup-path)
;; (display (color-message (format #f "Backed up ~a to ~a\n" path backup-path) green-text))
;; (log-action (format #f "Backed up ~a to ~a" path backup-path))))
;; ;;; Function to handle command-line arguments
;; (define (parse-arguments args)
;; "Parse command-line arguments."
;; (let* ((opts (getopt-long args
;; '((target (value #t) (required? #t))
;; (source (value #t) (required? #t))
;; (version (single-char #\v) (value #f))
;; (version (value #f))))))
;; opts))
;; ;;; Helper function to quote shell arguments
;; (define (shell-quote-argument arg)
;; "Quote shell argument to handle spaces or special characters."
;; (if (string-contains arg " ")
;; (string-append "\"" (string-replace arg "\"" "\\\"") "\"")
;; arg))
;; ;;; Helper function to delete a directory recursively
;; (define (delete-directory path)
;; "Delete a directory recursively."
;; (if (file-is-directory? path)
;; (begin
;; (system (string-append "rm -rf " (shell-quote-argument path))) ;; Use rm -rf to delete recursively
;; (log-action (format #f "Deleted directory: ~a" path))) ;; Log the deletion
;; (display (color-message "Error: Path is not a directory.\n" red-text))))
;; ;;; Helper function to move source to target
;; (define (move-source-to-target source-dir target-dir)
;; "Move the entire source directory to the target directory."
;; (let* ((source-dir (expand-home source-dir))
;; (target-dir (expand-home target-dir))
;; (source-name (basename source-dir))
;; (target-source-dir (string-append target-dir "/" source-name)))
;; ;; Check if the target directory already exists
;; (if (file-exists? target-source-dir)
;; (begin
;; (display (color-message (format #f "Directory ~a already exists.\n" target-source-dir) yellow-text))
;; ;; Handle the conflict: overwrite, backup, or skip
;; (let ((choice (prompt-user-for-backup-action)))
;; (cond
;; ((eq? choice 'overwrite)
;; (delete-directory target-source-dir)
;; (rename-file source-dir target-source-dir)
;; (display (color-message (format #f "Overwriting directory ~a.\n" target-source-dir) green-text))
;; (log-action (format #f "Overwritten directory: ~a" target-source-dir)))
;; ((eq? choice 'backup)
;; (backup-path target-source-dir)
;; (rename-file source-dir target-source-dir)
;; (display (color-message (format #f "Moved ~a to ~a\n" source-dir target-source-dir) green-text))
;; (log-action (format #f "Moved ~a to ~a after backup" source-dir target-source-dir)))
;; ((eq? choice 'skip)
;; (display (color-message "Skipping move operation.\n" green-text))
;; (log-action (format #f "Skipped moving directory: ~a" target-source-dir)))
;; ((eq? choice 'cancel)
;; (display (color-message "Operation cancelled by user.\n" yellow-text))
;; (log-action "Operation cancelled by user.")
;; (exit 0)))))
;; ;; If the target directory doesn't exist, proceed with the move
;; (begin
;; (rename-file source-dir target-source-dir)
;; (display (color-message (format #f "Moved ~a to ~a\n" source-dir target-source-dir) green-text))
;; (log-action (format #f "Moved ~a to ~a" source-dir target-source-dir))))
;; target-source-dir)) ;; Return the path of the moved source directory
;; ;;; Helper function to create a symlink in the parent directory of the original source
;; (define (create-symlink-in-parent source-dir target-dir)
;; "Create a symlink in the parent directory of source-dir."
;; (let* ((parent-dir (expand-home (dirname source-dir))) ;; Ensure the parent path is expanded
;; (symlink-target (string-append parent-dir "/" (basename source-dir)))
;; (target-dir (expand-home target-dir))) ;; Ensure the target path is expanded
;; ;; Check if symlink already exists
;; (if (file-exists? symlink-target)
;; (handle-conflicts source-dir symlink-target) ;; Handle conflict if symlink or file exists
;; (begin
;; ;; Create the symlink if no conflict
;; (symlink target-dir symlink-target)
;; (display (color-message (format #f "Symlink created at ~a pointing to ~a\n" symlink-target target-dir) green-text))
;; (log-action (format #f "Symlink created at ~a pointing to ~a" symlink-target target-dir))))))
;; ;;; Conflict resolution handler with backup option
;; (define (prompt-user-for-backup-action)
;; "Prompt the user to decide how to handle a conflict: overwrite (o), backup (b), skip (s), or cancel (c)."
;; (display (color-message "A conflict was detected. Choose action - Overwrite (o), Backup (b), Skip (s), or Cancel (c): " yellow-text))
;; (let ((response (read-line)))
;; (cond
;; ((string-ci=? response "o") 'overwrite)
;; ((string-ci=? response "b") 'backup)
;; ((string-ci=? response "s") 'skip)
;; ((string-ci=? response "c") 'cancel)
;; (else
;; (display (color-message "Invalid input. Please try again.\n" red-text))
;; (prompt-user-for-backup-action)))))
;; ;;; Function to handle conflicts with symlinks and directories
;; (define (handle-conflicts source target)
;; "Handle conflicts when a symlink or file already exists at the target location."
;; (display (color-message (format #f "Conflict detected! A file or symlink already exists at ~a.\n" target) yellow-text))
;; (let ((choice (prompt-user-for-backup-action))) ;; Prompt for backup or overwrite
;; (cond
;; ((eq? choice 'overwrite)
;; (if (file-is-symlink? target)
;; (begin
;; (delete-file target)
;; (display (color-message "Removed the existing symbolic link.\n" green-text))
;; (log-action (format #f "Removed the existing symbolic link at ~a" target))
;; (create-symlink-in-parent source target))
;; (display (color-message "Error: Target is not a symbolic link.\n" red-text))))
;; ((eq? choice 'backup)
;; (backup-path target) ;; Backup the existing directory or symlink
;; (create-symlink-in-parent source target)) ;; After backup, create the new symlink
;; ((eq? choice 'skip)
;; (log-action (format #f "Skipped creating symlink at ~a" target))
;; (display (color-message "Keeping existing symbolic link.\n" green-text)))
;; ((eq? choice 'cancel)
;; (log-action "Operation cancelled by user.")
;; (display (color-message "Operation cancelled.\n" yellow-text))
;; (exit 0))
;; (else
;; (display (color-message "Invalid choice. Please try again.\n" red-text))
;; (handle-conflicts source target)))))
;; ;;; Version function
;; (define (display-version)
;; "Display the current version of the program."
;; (display (format #f "Stash version ~a\n" "0.1.0-alpha.1")) ;; Update version number as needed
;; (exit 0))
;; ;;; Main function to handle source and target operations
;; (define (handle-source-and-target source-dir target-dir)
;; "Move the source directory to the target and create a symlink in the parent directory."
;; (let ((target-source-dir (move-source-to-target source-dir target-dir))) ;; Move the directory
;; (create-symlink-in-parent source-dir target-source-dir))) ;; Create the symlink if no conflict
;; ;;; Main entry point
;; (define (main args)
;; "Main function to parse arguments and execute the program."
;; (setenv "GUILE_AUTO_COMPILE" "0") ;; Disable auto-compilation to improve performance
;; (let* ((options (parse-arguments args)))
;; ;; Check for --version or -v option
;; (if (or (assoc-ref options 'version))
;; (display-version) ;; Display version and exit
;; ;; Proceed with regular functionality
;; (let* ((target-dir (assoc-ref options 'target))
;; (source-dir (assoc-ref options 'source)))
;; (if (and target-dir source-dir)
;; (handle-source-and-target source-dir target-dir) ;; Handle the source move and symlink creation
;; (begin
;; (display (color-message "Error: Missing required arguments.\n" red-text))
;; (display (color-message "Usage: stash.scm --target=<target-dir> --source=<source-dir>\n" yellow-text))
;; (exit 1)))))))
;; ;; Entry point for stash
;; (main (command-line))
;;; 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.
;;;
;;; 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:
;; Import necessary modules
;; (use-modules (ice-9 getopt-long)
;; (ice-9 popen)
;; (ice-9 rdelim)
;; (ice-9 format)
;; (srfi srfi-1)
;; (srfi srfi-19)) ;; Use for list handling and date-time formatting
;; ;;; ANSI Color Codes for terminal output
;; (define red-text "\x1b[31m")
;; (define yellow-text "\x1b[33m")
;; (define green-text "\x1b[32m")
;; (define reset-text "\x1b[0m")
;; ;;; Function to wrap messages in color
;; (define (color-message message color)
;; (string-append color message reset-text))
;; ;;; Version function
;; (define (display-version)
;; "Display the current version of the program."
;; (display (format #f "Stash version ~a\n" "0.1.0-alpha.1"))
;; (exit 0))
;; ;;; Improved logging function with timestamp
;; (define (log-action message)
;; "Log an action with a timestamp to the stash.log file."
;; (let ((log-port (open-file "stash.log" "a"))) ;; Open file in append mode
;; (display (string-append "[" (current-timestamp) "] " message) log-port)
;; (newline log-port)
;; (close-port log-port))) ;; Close the port after writing
;; ;;; Helper function to check for --version and -v before argument parsing
;; (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)))
;; ;;; Helper function to get a formatted current time string
;; (define (current-timestamp)
;; "Return the current date and time as a formatted string."
;; (let* ((time (current-time))
;; (seconds (time-second time)))
;; (strftime "%Y-%m-%d-%H-%M-%S" (localtime seconds))))
;; ;;; Expand ~ in paths to the full home directory path
;; (define (expand-home path)
;; "Expand ~ to the user's home directory."
;; (if (string-prefix? "~" path)
;; (string-append (getenv "HOME") (substring path 1))
;; path))
;; ;;; Function to handle command-line arguments
;; (define (parse-arguments args)
;; "Parse command-line arguments."
;; (getopt-long args
;; '((target (value #t))
;; (source (value #t)))))
;; ;;; Main function to handle source and target operations
;; (define (handle-source-and-target source-dir target-dir)
;; "Move the source directory to the target and create a symlink in the parent directory."
;; ;; Your existing logic for handling source and target directories
;; (display (format #f "Moving ~a to ~a\n" source-dir target-dir)))
;; ;;; Main entry point
;; (define (main args)
;; "Main function to parse arguments and execute the program."
;; (setenv "GUILE_AUTO_COMPILE" "0") ;; Disable auto-compilation to improve performance
;; ;; Check if --version or -v was passed
;; (check-for-version args)
;; ;; Parse remaining arguments
;; (let* ((options (parse-arguments args))
;; (target-dir (assoc-ref options 'target))
;; (source-dir (assoc-ref options 'source)))
;; (if (and target-dir source-dir)
;; (handle-source-and-target source-dir target-dir)
;; (begin
;; (display (color-message "Error: Missing required arguments.\n" red-text))
;; (display (color-message "Usage: stash.scm --target=<target-dir> --source=<source-dir>\n" yellow-text))
;; (exit 1)))))
;; ;; Entry point for stash
;; (main (command-line))
;;; 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.
;;;
;;; 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:
;; Import necessary modules
;; (use-modules (ice-9 getopt-long)
;; (ice-9 popen)
;; (ice-9 rdelim)
;; (ice-9 format)
;; (srfi srfi-1)
;; (srfi srfi-19)) ;; Use for list handling and date-time formatting
;; ;;; ANSI Color Codes for terminal output
;; (define red-text "\x1b[31m")
;; (define yellow-text "\x1b[33m")
;; (define green-text "\x1b[32m")
;; (define reset-text "\x1b[0m")
;; ;;; Function to wrap messages in color
;; (define (color-message message color)
;; (string-append color message reset-text))
;; ;;; Helper function to get a formatted current time string
;; (define (current-timestamp)
;; "Return the current date and time as a formatted string."
;; (let* ((time (current-time))
;; (seconds (time-second time)))
;; (strftime "%Y-%m-%d-%H-%M-%S" (localtime seconds))))
;; ;;; Improved logging function with timestamp
;; (define (log-action message)
;; "Log an action with a timestamp to the stash.log file."
;; (let ((log-port (open-file "stash.log" "a"))) ;; Open file in append mode
;; (display (string-append "[" (current-timestamp) "] " message) log-port)
;; (newline log-port)
;; (close-port log-port))) ;; Close the port after writing
;; ;;; Helper function to check for --version and -v before argument parsing
;; (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)))
;; ;;; Version function
;; (define (display-version)
;; "Display the current version of the program."
;; (display (format #f "Stash version ~a\n" "0.1.0-alpha.1"))
;; (exit 0))
;; ;;; Expand ~ in paths to the full home directory path
;; (define (expand-home path)
;; "Expand ~ to the user's home directory."
;; (if (string-prefix? "~" path)
;; (string-append (getenv "HOME") (substring path 1))
;; path))
;; ;;; Helper function to move source to target
;; (define (move-source-to-target source-dir target-dir)
;; "Move the entire source directory to the target directory."
;; (let* ((source-dir (expand-home source-dir))
;; (target-dir (expand-home target-dir))
;; (source-name (basename source-dir))
;; (target-source-dir (string-append target-dir "/" source-name)))
;; ;; Check if the target directory already exists
;; (if (file-exists? target-source-dir)
;; (begin
;; (display (color-message (format #f "Directory ~a already exists.\n" target-source-dir) yellow-text))
;; ;; Handle conflict: skip or overwrite
;; (log-action (format #f "Conflict: Directory ~a already exists" target-source-dir)))
;; ;; If the target directory doesn't exist, proceed with the move
;; (begin
;; (rename-file source-dir target-source-dir)
;; (display (color-message (format #f "Moved ~a to ~a\n" source-dir target-source-dir) green-text))
;; (log-action (format #f "Moved ~a to ~a" source-dir target-source-dir))))
;; target-source-dir)) ;; Return the path of the moved source directory
;; ;;; Helper function to create a symlink in the parent directory of the original source
;; (define (create-symlink-in-parent source-dir target-dir)
;; "Create a symlink in the parent directory of source-dir."
;; (let* ((parent-dir (expand-home (dirname source-dir))) ;; Ensure the parent path is expanded
;; (symlink-target (string-append parent-dir "/" (basename source-dir)))
;; (target-dir (expand-home target-dir))) ;; Ensure the target path is expanded
;; ;; Check if symlink already exists
;; (if (file-exists? symlink-target)
;; (begin
;; (display (color-message (format #f "Symlink ~a already exists.\n" symlink-target) yellow-text))
;; (log-action (format #f "Conflict: Symlink ~a already exists" symlink-target)))
;; (begin
;; ;; Create the symlink if no conflict
;; (symlink target-dir symlink-target)
;; (display (color-message (format #f "Symlink created at ~a pointing to ~a\n" symlink-target target-dir) green-text))
;; (log-action (format #f "Symlink created at ~a pointing to ~a" symlink-target target-dir))))))
;; ;;; Main function to handle source and target operations
;; (define (handle-source-and-target source-dir target-dir)
;; "Move the source directory to the target and create a symlink in the parent directory."
;; (let ((target-source-dir (move-source-to-target source-dir target-dir))) ;; Move the directory
;; (create-symlink-in-parent source-dir target-source-dir))) ;; Create the symlink
;; ;;; Function to handle command-line arguments
;; (define (parse-arguments args)
;; "Parse command-line arguments."
;; (getopt-long args
;; '((target (value #t))
;; (source (value #t)))))
;; ;;; Main entry point
;; (define (main args)
;; "Main function to parse arguments and execute the program."
;; (setenv "GUILE_AUTO_COMPILE" "0") ;; Disable auto-compilation to improve performance
;; ;; Check if --version or -v was passed
;; (check-for-version args)
;; ;; Parse remaining arguments
;; (let* ((options (parse-arguments args))
;; (target-dir (assoc-ref options 'target))
;; (source-dir (assoc-ref options 'source)))
;; (if (and target-dir source-dir)
;; (handle-source-and-target source-dir target-dir)
;; (begin
;; (display (color-message "Error: Missing required arguments.\n" red-text))
;; (display (color-message "Usage: stash.scm --target=<target-dir> --source=<source-dir>\n" yellow-text))
;; (exit 1)))))
;; ;; Entry point for stash
;; (main (command-line))
;; FINAL ATTEMP!!!
;;; 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.
;;;
;;; 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:
;; Import necessary modules
;; (use-modules (ice-9 getopt-long)
;; (ice-9 popen)
;; (ice-9 rdelim)
;; (ice-9 format)
;; (srfi srfi-1)
;; (srfi srfi-19)) ;; Use for list handling and date-time formatting
;; ;;; ANSI Color Codes for terminal output
;; (define red-text "\x1b[31m")
;; (define yellow-text "\x1b[33m")
;; (define green-text "\x1b[32m")
;; (define reset-text "\x1b[0m")
;; ;;; Function to wrap messages in color
;; (define (color-message message color)
;; (string-append color message reset-text))
;; ;;; Helper function to get a formatted current time string
;; (define (current-timestamp)
;; "Return the current date and time as a formatted string."
;; (let* ((time (current-time))
;; (seconds (time-second time)))
;; (strftime "%Y-%m-%d-%H-%M-%S" (localtime seconds))))
;; ;;; Improved logging function with timestamp
;; (define (log-action message)
;; "Log an action with a timestamp to the stash.log file."
;; (let ((log-port (open-file "stash.log" "a"))) ;; Open file in append mode
;; (display (string-append "[" (current-timestamp) "] " message) log-port)
;; (newline log-port)
;; (close-port log-port))) ;; Close the port after writing
;; ;;; Helper function to check for --version and -v before argument parsing
;; (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)))
;; ;;; Version function
;; (define (display-version)
;; "Display the current version of the program."
;; (display (format #f "Stash version ~a\n" "0.1.0-alpha.1"))
;; (exit 0))
;; ;;; Expand ~ in paths to the full home directory path
;; (define (expand-home path)
;; "Expand ~ to the user's home directory."
;; (if (string-prefix? "~" path)
;; (string-append (getenv "HOME") (substring path 1))
;; path))
;; ;;; Helper function to ensure target has .config appended
;; (define (ensure-config-path target-dir)
;; "Ensure that the target directory has .config appended."
;; (let ((target-dir (expand-home target-dir)))
;; (if (not (string-suffix? "/.config" target-dir))
;; (string-append target-dir "/.config")
;; target-dir)))
;; ;;; Helper function to move source to target
;; (define (move-source-to-target source-dir target-dir)
;; "Move the entire source directory to the target directory, ensuring .config in the target path."
;; (let* ((target-dir (ensure-config-path target-dir))
;; (source-dir (expand-home source-dir))
;; (source-name (basename source-dir))
;; (target-source-dir (string-append target-dir "/" source-name)))
;; ;; Ensure that the .config directory exists in the target
;; (if (not (file-exists? target-dir))
;; (mkdir target-dir #o755))
;; ;; Check if the target directory already exists
;; (if (file-exists? target-source-dir)
;; (begin
;; (display (color-message (format #f "Directory ~a already exists.\n" target-source-dir) yellow-text))
;; (log-action (format #f "Conflict: Directory ~a already exists" target-source-dir)))
;; ;; If the target directory doesn't exist, proceed with the move
;; (begin
;; (rename-file source-dir target-source-dir)
;; (display (color-message (format #f "Moved ~a to ~a\n" source-dir target-source-dir) green-text))
;; (log-action (format #f "Moved ~a to ~a" source-dir target-source-dir))))
;; target-source-dir)) ;; Return the path of the moved source directory
;; ;;; Helper function to create a symlink in the parent directory of the original source
;; (define (create-symlink-in-parent source-dir target-dir)
;; "Create a symlink in the parent directory of source-dir."
;; (let* ((parent-dir (expand-home (dirname source-dir))) ;; Ensure the parent path is expanded
;; (symlink-target (string-append parent-dir "/" (basename source-dir)))
;; (target-dir (expand-home target-dir))) ;; Ensure the target path is expanded
;; ;; Check if symlink already exists
;; (if (file-exists? symlink-target)
;; (begin
;; (display (color-message (format #f "Symlink ~a already exists.\n" symlink-target) yellow-text))
;; (log-action (format #f "Conflict: Symlink ~a already exists" symlink-target)))
;; (begin
;; ;; Create the symlink if no conflict
;; (symlink target-dir symlink-target)
;; (display (color-message (format #f "Symlink created at ~a pointing to ~a\n" symlink-target target-dir) green-text))
;; (log-action (format #f "Symlink created at ~a pointing to ~a" symlink-target target-dir))))))
;; ;;; Main function to handle source and target operations
;; (define (handle-source-and-target source-dir target-dir)
;; "Move the source directory to the target and create a symlink in the parent directory."
;; (let ((target-source-dir (move-source-to-target source-dir target-dir))) ;; Move the directory
;; (create-symlink-in-parent source-dir target-source-dir))) ;; Create the symlink
;; ;;; Function to handle command-line arguments
;; (define (parse-arguments args)
;; "Parse command-line arguments."
;; (getopt-long args
;; '((target (value #t))
;; (source (value #t)))))
;; ;;; Main entry point
;; (define (main args)
;; "Main function to parse arguments and execute the program."
;; (setenv "GUILE_AUTO_COMPILE" "0") ;; Disable auto-compilation to improve performance
;; ;; Check if --version or -v was passed
;; (check-for-version args)
;; ;; Parse remaining arguments
;; (let* ((options (parse-arguments args))
;; (target-dir (assoc-ref options 'target))
;; (source-dir (assoc-ref options 'source)))
;; (if (and target-dir source-dir)
;; (handle-source-and-target source-dir target-dir)
;; (begin
;; (display (color-message "Error: Missing required arguments.\n" red-text))
;; (display (color-message "Usage: stash.scm --target=<target-dir> --source=<source-dir>\n" yellow-text))
;; (exit 1)))))
;; ;; Entry point for stash
;; (main (command-line))
;; The code below seems to be fully correct...
;; ;;; 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
;; ;;;
;; ;;; Code:
;; ;; Import necessary modules
;; (use-modules (ice-9 getopt-long)
;; (ice-9 popen)
;; (ice-9 rdelim)
;; (ice-9 format)
;; (srfi srfi-1)
;; (srfi srfi-19)) ;; Use for list handling and date-time formatting
;; ;;; ANSI Color Codes for terminal output
;; (define red-text "\x1b[31m")
;; (define yellow-text "\x1b[33m")
;; (define green-text "\x1b[32m")
;; (define reset-text "\x1b[0m")
;; ;;; Function to wrap messages in color
;; (define (color-message message color)
;; (string-append color message reset-text))
;; ;;; Helper function to get a formatted current time string
;; (define (current-timestamp)
;; "Return the current date and time as a formatted string."
;; (let* ((time (current-time))
;; (seconds (time-second time)))
;; (strftime "%Y-%m-%d-%H-%M-%S" (localtime seconds))))
;; ;;; Improved logging function with timestamp
;; (define (log-action message)
;; "Log an action with a timestamp to the stash.log file."
;; (let ((log-port (open-file "stash.log" "a"))) ;; Open file in append mode
;; (display (string-append "[" (current-timestamp) "] " message) log-port)
;; (newline log-port)
;; (close-port log-port))) ;; Close the port after writing
;; ;;; Helper function to check for --version and -v before argument parsing
;; (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)))
;; ;;; Version function
;; (define (display-version)
;; "Display the current version of the program."
;; (display (format #f "Stash version ~a\n" "0.1.0-alpha.1"))
;; (exit 0))
;; ;;; Expand ~ in paths to the full home directory path
;; (define (expand-home path)
;; "Expand ~ to the user's home directory."
;; (if (string-prefix? "~" path)
;; (string-append (getenv "HOME") (substring path 1))
;; path))
;; ;;; Helper function to quote shell arguments
;; (define (shell-quote-argument arg)
;; "Quote shell argument to handle spaces or special characters."
;; (if (string-contains arg " ")
;; (string-append "\"" (string-replace arg "\"" "\\\"") "\"")
;; arg))
;; ;;; Conflict resolution handler with backup option
;; (define (prompt-user-for-action)
;; "Prompt the user to decide how to handle a conflict: overwrite (o), skip (s), or cancel (c)."
;; (display (color-message "A conflict was detected. Choose action - Overwrite (o), Skip (s), or Cancel (c): " yellow-text))
;; (let ((response (read-line)))
;; (cond
;; ((string-ci=? response "o") 'overwrite)
;; ((string-ci=? response "s") 'skip)
;; ((string-ci=? response "c") 'cancel)
;; (else
;; (display (color-message "Invalid input. Please try again.\n" red-text))
;; (prompt-user-for-action)))))
;; ;;; Helper function to delete a directory recursively
;; (define (delete-directory path)
;; "Delete a directory recursively."
;; (if (file-is-directory? path)
;; (begin
;; (system (string-append "rm -rf " (shell-quote-argument path)))
;; (log-action (format #f "Deleted directory: ~a" path)))
;; (display (color-message "Error: Path is not a directory.\n" red-text))))
;; ;;; Helper function to handle conflicts
;; (define (handle-conflict target-source-dir source-dir)
;; "Handle conflicts when the target directory already exists."
;; (let ((choice (prompt-user-for-action)))
;; (cond
;; ((eq? choice 'overwrite)
;; (delete-directory target-source-dir)
;; (rename-file source-dir target-source-dir)
;; (display (color-message (format #f "Overwriting directory ~a.\n" target-source-dir) green-text))
;; (log-action (format #f "Overwritten directory: ~a" target-source-dir)))
;; ((eq? choice 'skip)
;; (display (color-message "Skipping move operation.\n" green-text))
;; (log-action (format #f "Skipped moving directory: ~a" target-source-dir)))
;; ((eq? choice 'cancel)
;; (display (color-message "Operation cancelled by user.\n" yellow-text))
;; (log-action "Operation cancelled by user.")
;; (exit 0)))))
;; ;;; Helper function to ensure target has .config appended
;; (define (ensure-config-path target-dir)
;; "Ensure that the target directory has .config appended."
;; (let ((target-dir (expand-home target-dir)))
;; (if (not (string-suffix? "/.config" target-dir))
;; (string-append target-dir "/.config")
;; target-dir)))
;; ;;; Helper function to move source to target
;; (define (move-source-to-target source-dir target-dir)
;; "Move the entire source directory to the target directory, ensuring .config in the target path."
;; (let* ((target-dir (ensure-config-path target-dir))
;; (source-dir (expand-home source-dir))
;; (source-name (basename source-dir))
;; (target-source-dir (string-append target-dir "/" source-name)))
;; ;; Ensure that the .config directory exists in the target
;; (if (not (file-exists? target-dir))
;; (mkdir target-dir #o755))
;; ;; Check if the target directory already exists
;; (if (file-exists? target-source-dir)
;; (handle-conflict target-source-dir source-dir)
;; ;; If the target directory doesn't exist, proceed with the move
;; (begin
;; (rename-file source-dir target-source-dir)
;; (display (color-message (format #f "Moved ~a to ~a\n" source-dir target-source-dir) green-text))
;; (log-action (format #f "Moved ~a to ~a" source-dir target-source-dir))))
;; target-source-dir)) ;; Return the path of the moved source directory
;; ;;; Helper function to create a symlink in the parent directory of the original source
;; (define (create-symlink-in-parent source-dir target-dir)
;; "Create a symlink in the parent directory of source-dir."
;; (let* ((parent-dir (expand-home (dirname source-dir))) ;; Ensure the parent path is expanded
;; (symlink-target (string-append parent-dir "/" (basename source-dir)))
;; (target-dir (expand-home target-dir))) ;; Ensure the target path is expanded
;; ;; Check if symlink already exists
;; (if (file-exists? symlink-target)
;; (let ((choice (prompt-user-for-action)))
;; (cond
;; ((eq? choice 'overwrite)
;; (delete-file symlink-target)
;; (symlink target-dir symlink-target)
;; (display (color-message (format #f "Overwriting symlink ~a pointing to ~a\n" symlink-target target-dir) green-text))
;; (log-action (format #f "Overwritten symlink: ~a pointing to ~a" symlink-target target-dir)))
;; ((eq? choice 'skip)
;; (display (color-message "Skipping symlink creation.\n" green-text))
;; (log-action (format #f "Skipped symlink creation: ~a" symlink-target)))
;; ((eq? choice 'cancel)
;; (display (color-message "Operation cancelled by user.\n" yellow-text))
;; (log-action "Operation cancelled by user.")
;; (exit 0))))
;; ;; Create the symlink if no conflict
;; (begin
;; (symlink target-dir symlink-target)
;; (display (color-message (format #f "Symlink created at ~a pointing to ~a\n" symlink-target target-dir) green-text))
;; (log-action (format #f "Symlink created at ~a pointing to ~a" symlink-target target-dir))))))
;; ;;; Main function to handle source and target operations
;; (define (handle-source-and-target source-dir target-dir)
;; "Move the source directory to the target and create a symlink in the parent directory."
;; (let ((target-source-dir (move-source-to-target source-dir target-dir))) ;; Move the directory
;; (create-symlink-in-parent source-dir target-source-dir))) ;; Create the symlink
;; ;;; Function to handle command-line arguments
;; (define (parse-arguments args)
;; "Parse command-line arguments."
;; (getopt-long args
;; '((target (value #t))
;; (source (value #t)))))
;; ;;; Main entry point
;; (define (main args)
;; "Main function to parse arguments and execute the program."
;; (setenv "GUILE_AUTO_COMPILE" "0") ;; Disable auto-compilation to improve performance
;; ;; Check if --version or -v was passed
;; (check-for-version args)
;; ;; Parse remaining arguments
;; (let* ((options (parse-arguments args))
;; (target-dir (assoc-ref options 'target))
;; (source-dir (assoc-ref options 'source)))
;; (if (and target-dir source-dir)
;; (handle-source-and-target source-dir target-dir)
;; (begin
;; (display (color-message "Error: Missing required arguments.\n" red-text))
;; (display (color-message "Usage: stash.scm --target=<target-dir> --source=<source-dir>\n" yellow-text))
;; (exit 1)))))
;; ;; Entry point for stash
;; (main (command-line))
;;; 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
;;;
;;; Code:
;; Import necessary modules
(use-modules (ice-9 getopt-long)
(ice-9 popen)
(ice-9 rdelim)
(ice-9 format)
(srfi srfi-1)
(srfi srfi-19)) ;; Use for list handling and date-time formatting
;;; ANSI Color Codes for terminal output
(define red-text "\x1b[31m")
(define yellow-text "\x1b[33m")
(define green-text "\x1b[32m")
(define reset-text "\x1b[0m")
;;; Function to wrap messages in color
(define (color-message message color)
(string-append color message reset-text))
;;; Helper function to get a formatted current time string
(define (current-timestamp)
"Return the current date and time as a formatted string."
(let* ((time (current-time))
(seconds (time-second time)))
(strftime "%Y-%m-%d-%H-%M-%S" (localtime seconds))))
;;; Improved logging function with timestamp
(define (log-action message)
"Log an action with a timestamp to the stash.log file."
(let ((log-port (open-file "stash.log" "a"))) ;; Open file in append mode
(display (string-append "[" (current-timestamp) "] " message) log-port)
(newline log-port)
(close-port log-port))) ;; Close the port after writing
;;; Helper function to check for --version and -v before argument parsing
(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)))
;;; Version function
(define (display-version)
"Display the current version of the program."
(display (format #f "Stash version ~a\n" "0.1.0-alpha.1"))
(exit 0))
;;; Expand ~ in paths to the full home directory path
(define (expand-home path)
"Expand ~ to the user's home directory."
(if (string-prefix? "~" path)
(string-append (getenv "HOME") (substring path 1))
path))
;;; Helper function to quote shell arguments
(define (shell-quote-argument arg)
"Quote shell argument to handle spaces or special characters."
(if (string-contains arg " ")
(string-append "\"" (string-replace arg "\"" "\\\"") "\"")
arg))
;;; Helper function to concatenate paths safely
(define (concat-path base path)
"Concatenate two paths, ensuring there are no double slashes."
(if (string-suffix? "/" base)
(string-append (string-drop-right base 1) "/" path)
(string-append base "/" path)))
;;; Conflict resolution handler with backup option
(define (prompt-user-for-action)
"Prompt the user to decide how to handle a conflict: overwrite (o), skip (s), or cancel (c)."
(display (color-message "A conflict was detected. Choose action - Overwrite (o), Skip (s), or Cancel (c): " yellow-text))
(let ((response (read-line)))
(cond
((string-ci=? response "o") 'overwrite)
((string-ci=? response "s") 'skip)
((string-ci=? response "c") 'cancel)
(else
(display (color-message "Invalid input. Please try again.\n" red-text))
(prompt-user-for-action)))))
;;; Helper function to delete a directory recursively
(define (delete-directory path)
"Delete a directory recursively."
(if (file-is-directory? path)
(begin
(system (string-append "rm -rf " (shell-quote-argument path)))
(log-action (format #f "Deleted directory: ~a" path)))
(display (color-message "Error: Path is not a directory.\n" red-text))))
;;; Helper function to handle conflicts
(define (handle-conflict target-source-dir source-dir)
"Handle conflicts when the target directory already exists."
(let ((choice (prompt-user-for-action)))
(cond
((eq? choice 'overwrite)
(delete-directory target-source-dir)
(rename-file source-dir target-source-dir)
(display (color-message (format #f "Overwriting directory ~a.\n" target-source-dir) green-text))
(log-action (format #f "Overwritten directory: ~a" target-source-dir)))
((eq? choice 'skip)
(display (color-message "Skipping move operation.\n" green-text))
(log-action (format #f "Skipped moving directory: ~a" target-source-dir)))
((eq? choice 'cancel)
(display (color-message "Operation cancelled by user.\n" yellow-text))
(log-action "Operation cancelled by user.")
(exit 0)))))
;;; Helper function to ensure target has .config appended, avoiding double slashes
(define (ensure-config-path target-dir)
"Ensure that the target directory has .config appended, avoiding double slashes."
(let ((target-dir (expand-home target-dir)))
(if (string-suffix? "/" target-dir)
(set! target-dir (string-drop-right target-dir 1))) ;; Remove trailing slash if it exists
(if (not (string-suffix? "/.config" target-dir))
(string-append target-dir "/.config")
target-dir)))
;;; Helper function to move source to target
(define (move-source-to-target source-dir target-dir)
"Move the entire source directory to the target directory, ensuring .config in the target path."
(let* ((target-dir (ensure-config-path target-dir))
(source-dir (expand-home source-dir))
(source-name (basename source-dir))
(target-source-dir (concat-path target-dir source-name)))
;; Ensure that the .config directory exists in the target
(if (not (file-exists? target-dir))
(mkdir target-dir #o755))
;; Check if the target directory already exists
(if (file-exists? target-source-dir)
(handle-conflict target-source-dir source-dir)
;; If the target directory doesn't exist, proceed with the move
(begin
(rename-file source-dir target-source-dir)
(display (color-message (format #f "Moved ~a to ~a\n" source-dir target-source-dir) green-text))
(log-action (format #f "Moved ~a to ~a" source-dir target-source-dir))))
target-source-dir)) ;; Return the path of the moved source directory
;;; Helper function to create a symlink in the parent directory of the original source
(define (create-symlink-in-parent source-dir target-dir)
"Create a symlink in the parent directory of source-dir."
(let* ((parent-dir (expand-home (dirname source-dir))) ;; Ensure the parent path is expanded
(symlink-target (concat-path parent-dir (basename source-dir)))
(target-dir (expand-home target-dir))) ;; Ensure the target path is expanded
;; Check if symlink already exists
(if (file-exists? symlink-target)
(let ((choice (prompt-user-for-action)))
(cond
((eq? choice 'overwrite)
(delete-file symlink-target)
(symlink target-dir symlink-target)
(display (color-message (format #f "Overwriting symlink ~a pointing to ~a\n" symlink-target target-dir) green-text))
(log-action (format #f "Overwritten symlink: ~a pointing to ~a" symlink-target target-dir)))
((eq? choice 'skip)
(display (color-message "Skipping symlink creation.\n" green-text))
(log-action (format #f "Skipped symlink creation: ~a" symlink-target)))
((eq? choice 'cancel)
(display (color-message "Operation cancelled by user.\n" yellow-text))
(log-action "Operation cancelled by user.")
(exit 0))))
;; Create the symlink if no conflict
(begin
(symlink target-dir symlink-target)
(display (color-message (format #f "Symlink created at ~a pointing to ~a\n" symlink-target target-dir) green-text))
(log-action (format #f "Symlink created at ~a pointing to ~a" symlink-target target-dir))))))
;;; Main function to handle source and target operations
(define (handle-source-and-target source-dir target-dir)
"Move the source directory to the target and create a symlink in the parent directory."
(let ((target-source-dir (move-source-to-target source-dir target-dir))) ;; Move the directory
(create-symlink-in-parent source-dir target-source-dir))) ;; Create the symlink
;;; Function to handle command-line arguments
(define (parse-arguments args)
"Parse command-line arguments."
(getopt-long args
'((target (value #t))
(source (value #t)))))
;;; Main entry point
(define (main args)
"Main function to parse arguments and execute the program."
(setenv "GUILE_AUTO_COMPILE" "0") ;; Disable auto-compilation to improve performance
;; Check if --version or -v was passed
(check-for-version args)
;; Parse remaining arguments
(let* ((options (parse-arguments args))
(target-dir (assoc-ref options 'target))
(source-dir (assoc-ref options 'source)))
(if (and target-dir source-dir)
(handle-source-and-target source-dir target-dir)
(begin
(display (color-message "Error: Missing required arguments.\n" red-text))
(display (color-message "Usage: stash.scm --target=<target-dir> --source=<source-dir>\n" yellow-text))
(exit 1)))))
;; Entry point for stash
(main (command-line))
Reference in New Issue View Git Blame Copy Permalink