From 74d8470c78f7c88a2f35e7952a21d8d8a1f30cd4 Mon Sep 17 00:00:00 2001 From: GLENN THOMPSON Date: Wed, 11 Sep 2024 07:32:36 +0300 Subject: [PATCH] Updated guile-stash.scm to reflect experimental changes --- guile-stash.scm | 78 +++++++++++++++++++++++++++++++------------------ 1 file changed, 49 insertions(+), 29 deletions(-) diff --git a/guile-stash.scm b/guile-stash.scm index 3c756e2..f0e0c2e 100644 --- a/guile-stash.scm +++ b/guile-stash.scm @@ -89,57 +89,77 @@ #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)) + "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 "r") 'rename) + ((string-ci=? response "c") 'cancel) (else - (display (color-message "Invalid input. " red-text)) + (display (color-message "Invalid input. Please try again.\n" red-text)) (prompt-user-for-action))))) ; Recursive call on invalid input. -(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 (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 directory at the target location." - (let ((target-symlink-path (string-append target "/" (basename source)))) + "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 target-symlink-path source) ; Call conflict handler if file exists + (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 (string-append "Symlink created for: " target-symlink-path " -> " source "\n") green-text))) + (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)) + (let ((choice (prompt-user-for-action))) ;; Call the updated prompt-user-for-action + (cond + ((eq? choice 'overwrite) + ;; 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 'skip) + ;; Do nothing; keep the existing symbolic link. + (display (color-message "Keeping existing symbolic link.\n" green-text))) + ((eq? choice 'cancel) + ;; Cancel the operation and exit + (display (color-message "Operation cancelled.\n" yellow-text)) + (exit 0)) + (else + ;; Invalid input (this should never happen because prompt-user-for-action handles it). + (display (color-message "Invalid choice. Please try again.\n" red-text)) + (handle-conflicts source target))))) + (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) - (create-symlink package-dir target-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))