Updated guile-stash.scm to reflect experimental changes

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=<target-dir> --package-dir=<package-dir>\n" yellow-text))