From 6c6493a2a7bdb2cf9aff64d7c8ec9cab363a223c Mon Sep 17 00:00:00 2001 From: GLENN THOMPSON Date: Fri, 4 Oct 2024 10:19:44 +0300 Subject: [PATCH] Removed redundant code and comments --- stash.scm | 1070 ----------------------------------------------------- 1 file changed, 1070 deletions(-) diff --git a/stash.scm b/stash.scm index e3fd8ea..83368f1 100644 --- a/stash.scm +++ b/stash.scm @@ -30,1077 +30,7 @@ ;; ;;; ;; ;;; 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 -;;; 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)) - -;; ;;; 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: -;;; -;;; 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 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