diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..3d9c31e --- /dev/null +++ b/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. diff --git a/guile-stash.scm b/guile-stash.scm new file mode 100644 index 0000000..37a6da0 --- /dev/null +++ b/guile-stash.scm @@ -0,0 +1,150 @@ +;;; guile-stash.scm --- A Guile script for creating and managing symlinks with conflict resolution +;;; +;;; Author: Glenn Thompson +;;; 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= --package-dir= +;;; +;;; Replace with the directory where you want the symlink(s) to be created, +;;; and 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= --package-dir=\n" yellow-text)) + (exit 1))))) + +;; Entry point for guile-stash +(main (command-line))