;;; Code: ;; Import necessary modules (use-modules (ice-9 getopt-long) (ice-9 popen) ;; Additional module for executing system commands (ice-9 rdelim)) ;;; 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)) (define (shell-quote-argument arg) (if (string-contains arg " ") (string-append "\"" (string-replace arg "\"" "\\\"") "\"") arg)) (define (parse-arguments args) "Parse command-line arguments." (let* ((opts (getopt-long args '((target (value #t) (required? #t)) (package-dir (value #t) (required? #t)))))) opts)) (define (delete-directory path) (if (file-is-directory? path) (begin (system (string-append "rm -r " (shell-quote-argument path))) #t) #f)) (define (prompt-user-for-action) "Prompt the user to decide how to handle a conflict: overwrite (o), skip (s), or rename (r)." (display (color-message "A conflict was detected. Choose action - Overwrite (o), Skip (s), or Rename (r): " yellow-text)) (let ((response (read-line))) (cond ((string-ci=? response "o") 'overwrite) ((string-ci=? response "s") 'skip) ((string-ci=? response "r") 'rename) (else (display (color-message "Invalid input. " red-text)) (prompt-user-for-action))))) ; Recursive call on invalid input. (define (file-is-symlink? path) ;; Use lstat to check if the file is a symbolic link without following it (let ((stat (lstat path))) (eqv? (stat:type stat) 'symlink))) (define (create-symlink source target) "Create a symlink for the source file or directory at the target location." ;; Determine whether source is a file or directory and adjust the target path accordingly. (let ((target-symlink-path (if (file-is-directory? source) (string-append target "/" (basename source)) ;; If it's a directory, append the directory name to the target (string-append target "/" (basename source))))) ;; If it's a file, append the file name to the target (if (file-exists? target-symlink-path) (handle-conflicts source target-symlink-path) ; Call conflict handler if symlink already exists (catch 'system-error (lambda () (symlink source target-symlink-path) (display (color-message (format #f "Symlink created: ~a -> ~a\n" target-symlink-path source) green-text))) (lambda args (display (color-message "Error creating symlink.\n" red-text))))))) (define (handle-conflicts source target) ;; Display the conflict message in yellow (warning). (display (color-message (format #f "Conflict detected! A symbolic link already exists at ~a.\n" target) yellow-text)) (display "Do you want to:\n") (display "1. Remove the existing symbolic link and create a new one\n") (display "2. Keep the existing symbolic link\n") (display "3. Cancel the operation\n") (display "> ") (let ((choice (read))) (cond ((eq? choice 1) ;; Check if the target is a symlink, and remove the symlink (not the directory it points to). (if (file-is-symlink? target) (begin (delete-file target) ;; Safely delete the symlink. (display (color-message "Removed the existing symbolic link.\n" green-text)) ;; Now, recreate the symlink after removing the old one (create-symlink source (dirname target))) (display (color-message "Error: Target is not a symbolic link.\n" red-text)))) ((eq? choice 2) ;; Do nothing; keep the existing symbolic link. (display (color-message "Keeping existing symbolic link.\n" green-text))) ((eq? choice 3) ;; Cancel the operation and exit (display (color-message "Operation cancelled.\n" yellow-text)) (exit 0)) (else ;; Invalid input, so retry. (display (color-message "Invalid choice. Please try again.\n" red-text)) (handle-conflicts source target))))) ;; (define (handle-conflicts source target) ;; ;; Display the conflict message in yellow (warning). ;; (display (color-message (format #f "Conflict detected! A symbolic link already exists at ~a.\n" target) yellow-text)) ;; (display "Do you want to:\n") ;; (display "1. Remove the existing symbolic link and create a new one\n") ;; (display "2. Keep the existing symbolic link\n") ;; (display "> ") ;; (let ((choice (read))) ;; (cond ;; ((eq? choice 1) ;; ;; Check if the target is a symlink, and remove the symlink (not the directory it points to). ;; (if (file-is-symlink? target) ;; (begin ;; (delete-file target) ;; Safely delete the symlink. ;; (display (color-message "Removed the existing symbolic link and created a new one.\n" green-text))) ;; (display (color-message "Error: Target is not a symbolic link.\n" red-text)))) ;; ((eq? choice 2) ;; ;; Do nothing; keep the existing symbolic link. ;; (display (color-message "Keeping existing symbolic link.\n" green-text))) ;; (else ;; ;; Invalid input, so retry. ;; (display (color-message "Invalid choice. Please try again.\n" red-text)) ;; (handle-conflicts source target))))) ;; (define (handle-conflicts source target) ;; ;; Display the conflict message in yellow (warning). ;; (display (color-message (format #f "Conflict detected! A symbolic link already exists at ~a.\n" target) yellow-text)) ;; (display "Do you want to:\n") ;; (display "1. Remove the existing symbolic link and create a new one\n") ;; (display "2. Keep the existing symbolic link\n") ;; (display "> ") ;; (let ((choice (read))) ;; (cond ;; ((eq? choice 1) ;; ;; Check if the target is a symlink, and remove the symlink (not the directory it points to). ;; (if (file-is-symlink? target) ;; (begin ;; (delete-file target) ;; Safely delete the symlink. ;; (display (color-message "Removed the existing symbolic link and created a new one.\n" green-text))) ;; Use display ;; (display (color-message "Error: Target is not a symbolic link.\n" red-text)))) ;; Use display ;; ((eq? choice 2) ;; ;; Do nothing; keep the existing symbolic link. ;; (display (color-message "Keeping existing symbolic link.\n" green-text))) ;; Use display ;; (else ;; ;; Invalid input, so retry. ;; (display (color-message "Invalid choice. Please try again.\n" red-text)) ;; Use display ;; (handle-conflicts source target))))) ;; (define (handle-conflicts source target) ;; ;; Display the conflict message in yellow (warning). ;; (display (color-message (format #f "Conflict detected! A symbolic link already exists at ~a.\n" target) yellow-text)) ;; (display "Do you want to:\n") ;; (display "1. Remove the existing symbolic link and create a new one\n") ;; (display "2. Keep the existing symbolic link\n") ;; (display "> ") ;; (let ((choice (read))) ;; (cond ;; ((eq? choice 1) ;; ;; Check if the target is a symlink, and remove the symlink (not the directory it points to). ;; (if (file-is-symlink? target) ;; (begin ;; (delete-file target) ;; Safely delete the symlink. ;; (color-message (format #f "Removed the existing symbolic link and created a new one.\n") green-text)) ;; (color-message (format #f "Error: Target is not a symbolic link.\n") red-text))) ;; ((eq? choice 2) ;; ;; Do nothing; keep the existing symbolic link. ;; (color-message (format #f "Keeping existing symbolic link.\n") green-text)) ;; (else ;; ;; Invalid input, so retry. ;; (color-message (format #f "Invalid choice. Please try again.\n") red-text) ;; (handle-conflicts source target))))) ;; (define (handle-conflicts source target) ;; ;; Display the conflict message in yellow (warning). ;; (display (color-message (format #f "Conflict detected! A symbolic link already exists at ~a.\n" target) yellow-text)) ;; (display "Do you want to:\n") ;; (display "1. Remove the existing symbolic link and create a new one\n") ;; (display "2. Keep the existing symbolic link\n") ;; (display "> ") ;; (let ((choice (read))) ;; (cond ;; ((eq? choice 1) ;; ;; Check if the target is a symlink, and remove the symlink (not the directory it points to). ;; (if (file-is-symlink? target) ;; (delete-file target) ;; Safely delete the symlink. ;; (format #t "Error: Target is not a symbolic link.\n")) ;; (format #t "Removed the existing symbolic link and created a new one.\n")) ;; ((eq? choice 2) ;; ;; Do nothing; keep the existing symbolic link. ;; (format #t "Keeping existing symbolic link.\n")) ;; (else ;; ;; Invalid input, so retry. ;; (format #t "Invalid choice. Please try again.\n") ;; (handle-conflicts source target))))) ;; This section kind of works. ;; (define (handle-conflicts source target) ;; ;; Display the conflict message with the target path. ;; (format #t "Conflict detected! A symbolic link already exists at ~a.\n" target) ;; (display "Do you want to:\n") ;; (display "1. Remove the existing link and create a new one\n") ;; (display "2. Keep the existing link\n") ;; (display "> ") ;; (let ((choice (read))) ;; (cond ;; ((eq? choice 1) ;; ;; Check if the target is a directory and remove it appropriately. ;; (if (file-is-directory? target) ;; (delete-directory target) ;; (delete-file target)) ;; (format #t "Removed the existing link and created a new one.\n")) ;; ((eq? choice 2) ;; ;; Do nothing; keep the existing link. ;; (format #t "Keeping existing link.\n")) ;; (else ;; ;; Invalid input, so retry. ;; (format #t "Invalid choice. Please try again.\n") ;; (handle-conflicts source target))))) ;; Original working code ;; (define (handle-conflicts existing-path new-symlink-path) ;; "Handle conflicts between existing files and new symlinks." ;; (case (prompt-user-for-action) ;; ((overwrite) ;; (if (file-is-directory? existing-path) ;; (delete-directory existing-path) ;; Call the delete-directory function ;; (delete-file existing-path)) ;; Use Guile's built-in delete-file for files ;; (symlink new-symlink-path existing-path) ;; (format #t (color-message (string-append "Existing file/directory overwritten with new symlink: " existing-path " -> " new-symlink-path "\n") green-text))) ;; ((skip) ;; (display (color-message "Skipped creating new symlink due to conflict.\n" red-text))) ;; ((rename) ;; ;; Prompt for new name and execute renaming ;; (display (color-message "Enter new name for the existing symlink or file: " yellow-text)) ;; (let ((new-name (read-line))) ;; (let ((new-path (string-append (dirname existing-path) "/" new-name))) ;; (rename-file existing-path new-path) ;; (format #t (color-message (string-append "Renamed " existing-path " to " new-name "\n") green-text))))) ;; (else ;; (display (color-message "No valid action selected, no changes made.\n" red-text))))) ;; (define (create-symlink source target) ;; "Create a symlink for the source directory at the target location." ;; (let ((target-symlink-path (string-append target "/" (basename source)))) ;; (if (file-exists? target-symlink-path) ;; (handle-conflicts target-symlink-path source) ; Call conflict handler if file exists ;; (catch 'system-error ;; (lambda () ;; (symlink source target-symlink-path) ;; (display (color-message (string-append "Symlink created for: " target-symlink-path " -> " source "\n") green-text))) ;; (lambda args ;; (display (color-message "Error creating symlink.\n" red-text))))))) ;;; Updated main function with error handling using `catch` (define (main args) "Main function to parse arguments and initiate processing." (setenv "GUILE_AUTO_COMPILE" "0") (let* ((options (parse-arguments args)) (target-dir (assoc-ref options 'target)) (package-dir (assoc-ref options 'package-dir))) (if (and target-dir package-dir) (catch 'symlink-error (lambda () (create-symlink package-dir target-dir)) ;; Try to create symlink (lambda (key . args) ;; Handle the 'symlink-error (display (color-message (format #f "Error creating symlink: ~a\n" (car args)) red-text)))) (begin (display (color-message "Error: Missing required arguments.\n" red-text)) (display (color-message "Usage: guile stash.scm --target= --package-dir=\n" yellow-text)) (exit 1))))) ;; Entry point for guile-stash (main (command-line))