push code base

LICENSE

@@ -0,0 +1,21 @@
+MIT License
+
+Copyright (c) 2024 Glenn Thompson
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

guile-stash.scm

@@ -0,0 +1,150 @@
+;;; guile-stash.scm --- A Guile script for creating and managing symlinks with conflict resolution
+;;;
+;;; Author: Glenn Thompson <glenn@kirstol.org>
+;;; Version: 1.1
+;;; Created: 2024-12-03
+;;; Compatibility: Guile 3.0.9
+;;; Keywords: symlink, file management, conflict resolution
+;;;
+;;; Commentary:
+;;;
+;;; Guile-Stash is a command-line utility written in Guile Scheme designed to facilitate the creation of symbolic links (symlinks)
+;;; for files and directories. It allows users to specify a source file or directory and a target directory where the symlink(s)
+;;; should be created. The utility handles potential conflicts with existing files or directories at the target location,
+;;; offering users the choice to overwrite 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 or skip).
+;;; - Support for symlinking both files and directories.
+;;; - Simple and interactive user interface for easy use.
+;;;
+;;; Usage:
+;;;
+;;; guile -L . guile-stash.scm --target=<target-dir> --package-dir=<package-dir>
+;;;
+;;; Replace <target-dir> with the directory where you want the symlink(s) to be created,
+;;; and <package-dir> with the path to the source file or directory.
+;;;
+;;; License:
+;;;
+;;; ;;; guile-stash.scm --- Description of the script
+;;;
+;;; Copyright (c) 2024 Glenn Thompson
+;;;
+;;; Permission is hereby granted, free of charge, to any person obtaining a copy
+;;; of this software and associated documentation files (the "Software"), to deal
+;;; in the Software without restriction, including without limitation the rights
+;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+;;; copies of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be included in all
+;;; copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;;; SOFTWARE.
+;;;
+;;; For the full license text, see the LICENSE file.
+
+;;; 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 (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) ; Checks if the path exists (file, directory, or symlink)
+        (handle-conflicts target-symlink-path source) ; Handle existing path
+        (begin
+          (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 "File exists.  Unable to create symlink.\n" red-text))))))))
+
+(define (main args)
+  "Main function to parse arguments and initiate processing."
+  (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)
+        (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))
+          (exit 1)))))
+
+;; Entry point for guile-stash
+(main (command-line))