diff --git a/stash.scm b/stash.scm index 10dfef9..e3fd8ea 100644 --- a/stash.scm +++ b/stash.scm @@ -1,3 +1,464 @@ +;; ;;; stash.scm --- A Guile script for moving directories and creating symlinks with conflict resolution +;; ;;; +;; ;;; Author: Glenn Thompson +;; ;;; 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= --source= +;; ;;; +;; ;;; Replace with the directory where you want the symlink to be created, +;; ;;; and 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= --source=\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 +;; ;;; 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= --source= +;; ;;; +;; ;;; Replace with the directory where you want the symlink to be created, +;; ;;; and 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= --source=\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 @@ -13,11 +474,119 @@ ;;; 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= --source= +;;; +;;; Replace with the directory where you want the symlink to be created, +;;; and 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= --source=\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 +;;; 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: ;;; @@ -32,6 +601,508 @@ ;;; ;;; 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= --source=\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 +;;; 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= --source= +;;; +;;; Replace with the directory where you want the symlink to be created, +;;; and 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= --source=\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 +;; ;;; 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= --source=\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 +;;; 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) @@ -65,6 +1136,19 @@ (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." @@ -72,22 +1156,6 @@ (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." @@ -95,46 +1163,76 @@ (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))) ;; Use rm -rf to delete recursively - (log-action (format #f "Deleted directory: ~a" path))) ;; Log the deletion + (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." - (let* ((source-dir (expand-home source-dir)) - (target-dir (expand-home 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))) + (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) - (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))))) + (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) @@ -146,74 +1244,56 @@ (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))) + (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) - (handle-conflicts source-dir symlink-target) ;; Handle conflict if symlink or file exists + (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 - ;; 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 + (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) ;; Handle the source move and symlink creation + (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= --source=\n" yellow-text))