mirror of https://codeberg.org/glenneth/stash.git
Created modules from main scm file
This commit is contained in:
GLENN THOMPSON
parent
c61aa562da
commit
f5c89a0b71
|
|
@ -0,0 +1,13 @@
|
|||
|
||||
(define-module (stash colors)
|
||||
#:export (red-text yellow-text green-text reset-text color-message))
|
||||
|
||||
;;; 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))
|
||||
|
|
@ -0,0 +1,76 @@
|
|||
;; stash-conflict.scm --- Conflict resolution module for Stash
|
||||
|
||||
;; (define-module (stash conflict)
|
||||
;; #:export (prompt-user-for-action handle-conflict))
|
||||
|
||||
;; ;; Import necessary modules
|
||||
;; (use-modules (ice-9 rdelim)) ;; Import read-line function for reading user input
|
||||
|
||||
;; ;;; Conflict resolution handler with user options
|
||||
;; (define (prompt-user-for-action)
|
||||
;; "Prompt the user to decide how to handle a conflict: overwrite (o), skip (s), or cancel (c)."
|
||||
;; (display "A conflict was detected. Choose action - Overwrite (o), Skip (s), or Cancel (c): ")
|
||||
;; (let ((response (read-line)))
|
||||
;; (cond
|
||||
;; ((string-ci=? response "o") 'overwrite)
|
||||
;; ((string-ci=? response "s") 'skip)
|
||||
;; ((string-ci=? response "c") 'cancel)
|
||||
;; (else
|
||||
;; (display "Invalid input. Please try again.\n")
|
||||
;; (prompt-user-for-action)))))
|
||||
|
||||
;; ;;; Helper function to handle conflicts
|
||||
;; (define (handle-conflict target-source-dir source-dir delete-directory log-action)
|
||||
;; "Handle conflicts when the target directory already exists."
|
||||
;; (let ((choice (prompt-user-for-action)))
|
||||
;; (cond
|
||||
;; ((eq? choice 'overwrite)
|
||||
;; (delete-directory target-source-dir)
|
||||
;; (rename-file source-dir target-source-dir)
|
||||
;; (display (format #f "Overwriting directory ~a.\n" target-source-dir))
|
||||
;; (log-action (format #f "Overwritten directory: ~a" target-source-dir)))
|
||||
;; ((eq? choice 'skip)
|
||||
;; (display "Skipping move operation.\n")
|
||||
;; (log-action (format #f "Skipped moving directory: ~a" target-source-dir)))
|
||||
;; ((eq? choice 'cancel)
|
||||
;; (display "Operation cancelled by user.\n")
|
||||
;; (log-action "Operation cancelled by user.")
|
||||
;; (exit 0)))))
|
||||
|
||||
(define-module (stash conflict)
|
||||
#:export (prompt-user-for-action handle-conflict))
|
||||
|
||||
;; Import necessary modules
|
||||
(use-modules (ice-9 rdelim)
|
||||
(stash colors)) ;; Import the colors module
|
||||
|
||||
;;; Conflict resolution handler with user options
|
||||
(define (prompt-user-for-action)
|
||||
"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)) ;; Yellow for prompt
|
||||
(let ((response (read-line)))
|
||||
(cond
|
||||
((string-ci=? response "o") 'overwrite)
|
||||
((string-ci=? response "s") 'skip)
|
||||
((string-ci=? response "c") 'cancel)
|
||||
(else
|
||||
(display (color-message "Invalid input. Please try again.\n" red-text)) ;; Red for invalid input
|
||||
(prompt-user-for-action)))))
|
||||
|
||||
;;; Helper function to handle conflicts
|
||||
(define (handle-conflict target-source-dir source-dir delete-directory log-action)
|
||||
"Handle conflicts when the target directory already exists."
|
||||
(let ((choice (prompt-user-for-action)))
|
||||
(cond
|
||||
((eq? choice 'overwrite)
|
||||
(delete-directory target-source-dir)
|
||||
(rename-file source-dir target-source-dir)
|
||||
(display (color-message (format #f "Overwriting directory ~a.\n" target-source-dir) green-text)) ;; Green for success
|
||||
(log-action (format #f "Overwritten directory: ~a" target-source-dir)))
|
||||
((eq? choice 'skip)
|
||||
(display (color-message "Skipping move operation.\n" green-text)) ;; Green for skipping
|
||||
(log-action (format #f "Skipped moving directory: ~a" target-source-dir)))
|
||||
((eq? choice 'cancel)
|
||||
(display (color-message "Operation cancelled by user.\n" yellow-text)) ;; Yellow for cancel
|
||||
(log-action "Operation cancelled by user.")
|
||||
(exit 0)))))
|
||||
|
|
@ -0,0 +1,139 @@
|
|||
;; stash-file-ops.scm --- File operations module for Stash
|
||||
|
||||
;; (define-module (stash file-ops)
|
||||
;; #:export (move-source-to-target create-symlink-in-parent delete-directory))
|
||||
|
||||
;; ;; Import necessary modules
|
||||
;; (use-modules (stash log) ;; Import log-action, current-timestamp
|
||||
;; (stash paths) ;; Import expand-home, concat-path, ensure-config-path
|
||||
;; (stash conflict)) ;; Import prompt-user-for-action, handle-conflict
|
||||
|
||||
;; ;;; Helper function to quote shell arguments
|
||||
;; (define (shell-quote-argument arg)
|
||||
;; "Quote shell argument to handle spaces or special characters."
|
||||
;; (if (string-contains arg " ")
|
||||
;; (string-append "\"" (string-replace arg "\"" "\\\"") "\"")
|
||||
;; arg))
|
||||
|
||||
;; ;;; Helper function to delete a directory recursively
|
||||
;; (define (delete-directory path)
|
||||
;; "Delete a directory recursively."
|
||||
;; (if (file-is-directory? path)
|
||||
;; (begin
|
||||
;; (system (string-append "rm -rf " (shell-quote-argument path)))
|
||||
;; (log-action (format #f "Deleted directory: ~a" path)))
|
||||
;; (display "Error: Path is not a directory.\n")))
|
||||
|
||||
;; ;;; Helper function to move source to target
|
||||
;; (define (move-source-to-target source-dir target-dir)
|
||||
;; "Move the entire source directory to the target directory, ensuring .config in the target path."
|
||||
;; (let* ((target-dir (ensure-config-path target-dir)) ;; Use ensure-config-path from paths.scm
|
||||
;; (source-dir (expand-home source-dir)) ;; Use expand-home from paths.scm
|
||||
;; (source-name (basename source-dir))
|
||||
;; (target-source-dir (concat-path target-dir source-name))) ;; Use concat-path from paths.scm
|
||||
;; ;; Ensure that the .config directory exists in the target
|
||||
;; (if (not (file-exists? target-dir))
|
||||
;; (mkdir target-dir #o755))
|
||||
;; ;; Check if the target directory already exists
|
||||
;; (if (file-exists? target-source-dir)
|
||||
;; (handle-conflict target-source-dir source-dir delete-directory log-action) ;; Conflict handling
|
||||
;; ;; If the target directory doesn't exist, proceed with the move
|
||||
;; (begin
|
||||
;; (rename-file source-dir target-source-dir)
|
||||
;; (display (format #f "Moved ~a to ~a\n" source-dir target-source-dir))
|
||||
;; (log-action (format #f "Moved ~a to ~a" source-dir target-source-dir))))
|
||||
;; target-source-dir)) ;; Return the path of the moved source directory
|
||||
|
||||
;; ;;; Helper function to create a symlink in the parent directory of the original source
|
||||
;; (define (create-symlink-in-parent source-dir target-dir)
|
||||
;; "Create a symlink in the parent directory of source-dir."
|
||||
;; (let* ((parent-dir (expand-home (dirname source-dir))) ;; Ensure the parent path is expanded
|
||||
;; (symlink-target (concat-path parent-dir (basename source-dir))) ;; Concatenate paths safely
|
||||
;; (target-dir (expand-home target-dir))) ;; Ensure the target path is expanded
|
||||
;; ;; Check if symlink already exists
|
||||
;; (if (file-exists? symlink-target)
|
||||
;; (let ((choice (prompt-user-for-action)))
|
||||
;; (cond
|
||||
;; ((eq? choice 'overwrite)
|
||||
;; (delete-file symlink-target)
|
||||
;; (symlink target-dir symlink-target)
|
||||
;; (display (format #f "Overwriting symlink ~a pointing to ~a\n" symlink-target target-dir))
|
||||
;; (log-action (format #f "Overwritten symlink: ~a pointing to ~a" symlink-target target-dir)))
|
||||
;; ((eq? choice 'skip)
|
||||
;; (display "Skipping symlink creation.\n")
|
||||
;; (log-action (format #f "Skipped symlink creation: ~a" symlink-target)))
|
||||
;; ((eq? choice 'cancel)
|
||||
;; (display "Operation cancelled by user.\n")
|
||||
;; (log-action "Operation cancelled by user.")
|
||||
;; (exit 0))))
|
||||
;; ;; Create the symlink if no conflict
|
||||
;; (begin
|
||||
;; (symlink target-dir symlink-target)
|
||||
;; (display (format #f "Symlink created at ~a pointing to ~a\n" symlink-target target-dir))
|
||||
;; (log-action (format #f "Symlink created at ~a pointing to ~a" symlink-target target-dir))))))
|
||||
|
||||
(define-module (stash file-ops)
|
||||
#:export (move-source-to-target create-symlink-in-parent delete-directory))
|
||||
|
||||
;; Import necessary modules
|
||||
(use-modules (stash colors) ;; Import color definitions
|
||||
(stash log)
|
||||
(stash paths)
|
||||
(stash conflict))
|
||||
|
||||
;;; Helper function to delete a directory recursively
|
||||
(define (delete-directory path)
|
||||
"Delete a directory recursively."
|
||||
(if (file-is-directory? path)
|
||||
(begin
|
||||
(system (string-append "rm -rf " (shell-quote-argument path)))
|
||||
(log-action (color-message (format #f "Deleted directory: ~a" path) green-text)))
|
||||
(display (color-message "Error: Path is not a directory.\n" red-text))))
|
||||
|
||||
;;; Helper function to move source to target
|
||||
(define (move-source-to-target source-dir target-dir)
|
||||
"Move the entire source directory to the target directory, ensuring .config in the target path."
|
||||
(let* ((target-dir (ensure-config-path target-dir))
|
||||
(source-dir (expand-home source-dir))
|
||||
(source-name (basename source-dir))
|
||||
(target-source-dir (concat-path target-dir source-name)))
|
||||
;; Ensure that the .config directory exists in the target
|
||||
(if (not (file-exists? target-dir))
|
||||
(mkdir target-dir #o755))
|
||||
;; Check if the target directory already exists
|
||||
(if (file-exists? target-source-dir)
|
||||
(handle-conflict target-source-dir source-dir delete-directory log-action)
|
||||
;; If the target directory doesn't exist, proceed with the move
|
||||
(begin
|
||||
(rename-file source-dir target-source-dir)
|
||||
(display (color-message (format #f "Moved ~a to ~a\n" source-dir target-source-dir) green-text))
|
||||
(log-action (format #f "Moved ~a to ~a" source-dir target-source-dir))))
|
||||
target-source-dir))
|
||||
|
||||
;;; Helper function to create a symlink in the parent directory of the original source
|
||||
(define (create-symlink-in-parent source-dir target-dir)
|
||||
"Create a symlink in the parent directory of source-dir."
|
||||
(let* ((parent-dir (expand-home (dirname source-dir)))
|
||||
(symlink-target (concat-path parent-dir (basename source-dir)))
|
||||
(target-dir (expand-home target-dir)))
|
||||
;; Check if symlink already exists
|
||||
(if (file-exists? symlink-target)
|
||||
(let ((choice (prompt-user-for-action)))
|
||||
(cond
|
||||
((eq? choice 'overwrite)
|
||||
(delete-file symlink-target)
|
||||
(symlink target-dir symlink-target)
|
||||
(display (color-message (format #f "Overwriting symlink ~a pointing to ~a\n" symlink-target target-dir) green-text))
|
||||
(log-action (format #f "Overwritten symlink: ~a pointing to ~a" symlink-target target-dir)))
|
||||
((eq? choice 'skip)
|
||||
(display (color-message "Skipping symlink creation.\n" green-text))
|
||||
(log-action (format #f "Skipped symlink creation: ~a" symlink-target)))
|
||||
((eq? choice 'cancel)
|
||||
(display (color-message "Operation cancelled by user.\n" yellow-text))
|
||||
(log-action "Operation cancelled by user.")
|
||||
(exit 0))))
|
||||
;; Create the symlink if no conflict
|
||||
(begin
|
||||
(symlink target-dir symlink-target)
|
||||
(display (color-message (format #f "Symlink created at ~a pointing to ~a\n" symlink-target target-dir) green-text))
|
||||
(log-action (format #f "Symlink created at ~a pointing to ~a" symlink-target target-dir))))))
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
;; stash-help.scm --- Help message module for Stash
|
||||
|
||||
(define-module (stash-help)
|
||||
(define-module (stash help)
|
||||
#:export (display-help))
|
||||
|
||||
;;; Function to display help message
|
||||
|
|
@ -0,0 +1,43 @@
|
|||
;; stash-log.scm --- Logging module for Stash
|
||||
|
||||
;; (define-module (stash log)
|
||||
;; #:export (log-action current-timestamp))
|
||||
|
||||
;; (use-modules (srfi srfi-19)) ;; For date and time functions
|
||||
|
||||
;; ;;; Function to get a formatted current time string
|
||||
;; (define (current-timestamp)
|
||||
;; "Return the current date and time as a formatted string."
|
||||
;; (let* ((time (current-time))
|
||||
;; (seconds (time-second time)))
|
||||
;; (strftime "%Y-%m-%d-%H-%M-%S" (localtime seconds))))
|
||||
|
||||
;; ;;; Function to log actions with a timestamp
|
||||
;; (define (log-action message)
|
||||
;; "Log an action with a timestamp to the stash.log file."
|
||||
;; (let ((log-port (open-file "stash.log" "a"))) ;; Open file in append mode
|
||||
;; (display (string-append "[" (current-timestamp) "] " message) log-port)
|
||||
;; (newline log-port)
|
||||
;; (close-port log-port)))
|
||||
|
||||
(define-module (stash log)
|
||||
#:export (log-action current-timestamp))
|
||||
|
||||
;; Import necessary modules
|
||||
(use-modules (stash colors) ;; Import color definitions
|
||||
(srfi srfi-19)) ;; For date and time handling
|
||||
|
||||
;;; Helper function to get a formatted current time string
|
||||
(define (current-timestamp)
|
||||
"Return the current date and time as a formatted string."
|
||||
(let* ((time (current-time))
|
||||
(seconds (time-second time)))
|
||||
(strftime "%Y-%m-%d-%H-%M-%S" (localtime seconds))))
|
||||
|
||||
;;; Improved logging function with timestamp and colored output
|
||||
(define (log-action message)
|
||||
"Log an action with a timestamp to the stash.log file."
|
||||
(let ((log-port (open-file "stash.log" "a"))) ;; Open file in append mode
|
||||
(display (color-message (string-append "[" (current-timestamp) "] " message) green-text) log-port) ;; Green text in logs
|
||||
(newline log-port)
|
||||
(close-port log-port)))
|
||||
|
|
@ -0,0 +1,28 @@
|
|||
;; stash-paths.scm --- Path handling module for Stash
|
||||
|
||||
(define-module (stash paths)
|
||||
#:export (expand-home concat-path ensure-config-path))
|
||||
|
||||
;;; Expand ~ in paths to the full home directory path
|
||||
(define (expand-home path)
|
||||
"Expand ~ to the user's home directory."
|
||||
(if (string-prefix? "~" path)
|
||||
(string-append (getenv "HOME") (substring path 1))
|
||||
path))
|
||||
|
||||
;;; Concatenate paths safely
|
||||
(define (concat-path base path)
|
||||
"Concatenate two paths, ensuring there are no double slashes."
|
||||
(if (string-suffix? "/" base)
|
||||
(string-append (string-drop-right base 1) "/" path)
|
||||
(string-append base "/" path)))
|
||||
|
||||
;;; Ensure target has .config appended, avoiding double slashes
|
||||
(define (ensure-config-path target-dir)
|
||||
"Ensure that the target directory has .config appended, avoiding double slashes."
|
||||
(let ((target-dir (expand-home target-dir)))
|
||||
(if (string-suffix? "/" target-dir)
|
||||
(set! target-dir (string-drop-right target-dir 1))) ;; Remove trailing slash if it exists
|
||||
(if (not (string-suffix? "/.config" target-dir))
|
||||
(string-append target-dir "/.config")
|
||||
target-dir)))
|
||||
68
stash.log
68
stash.log
|
|
@ -1,67 +1 @@
|
|||
Moved /home/glenn/.config/test to /home/glenn/.dotfiles/.config/test
|
||||
Symlink created at /home/glenn/.config/test pointing to /home/glenn/.dotfiles/.config/test
|
||||
Moved /home/glenn/.config/test to /home/glenn/.dotfiles/.config/test
|
||||
Moved /home/glenn/.config/test to /home/glenn/.dotfiles/.config/test
|
||||
Moved /home/glenn/.config/test to /home/glenn/.dotfiles/.config/test
|
||||
Symlink created at /home/glenn/.config/test pointing to /home/glenn/.dotfiles/.config/test
|
||||
[2024-09-22 11:08:52] Moved /home/glenn/.config/test to /home/glenn/.dotfiles/.config/test
|
||||
[2024-09-22 11:08:52] Symlink created at /home/glenn/.config/test pointing to /home/glenn/.dotfiles/.config/test
|
||||
[2024-09-22 13:52:41] Skipped moving directory: /home/glenn/.dotfiles/.config/test
|
||||
[2024-09-22 13:52:45] Operation cancelled by user.
|
||||
[2024-09-22 14:00:22] Deleted directory: /home/glenn/.dotfiles/.config/test
|
||||
[2024-09-22 14:00:22] Overwritten directory: /home/glenn/.dotfiles/.config/test
|
||||
[2024-09-22 14:00:22] Symlink created at /home/glenn/.config/test pointing to /home/glenn/.dotfiles/.config/test
|
||||
[2024-09-22-14-13-00] Moved /home/glenn/.config/test to /home/glenn/.dotfiles/.config/test
|
||||
[2024-09-22-14-13-00] Symlink created at /home/glenn/.config/test pointing to /home/glenn/.dotfiles/.config/test
|
||||
[2024-09-22-14-13-09] Backed up /home/glenn/.dotfiles/.config/test to /home/glenn/.dotfiles/.config/test.backup.2024-09-22-14-13-09
|
||||
[2024-09-22-14-13-09] Moved /home/glenn/.config/test to /home/glenn/.dotfiles/.config/test after backup
|
||||
[2024-09-22-14-13-09] Symlink created at /home/glenn/.config/test pointing to /home/glenn/.dotfiles/.config/test
|
||||
[2024-09-22-14-20-03] Moved /home/glenn/.config/test to /home/glenn/.dotfiles/.config/test
|
||||
[2024-09-22-14-20-03] Symlink created at /home/glenn/.config/test pointing to /home/glenn/.dotfiles/.config/test
|
||||
[2024-09-22-14-20-09] Backed up /home/glenn/.dotfiles/.config/test to /home/glenn/.dotfiles/.config/test.backup.2024-09-22-14-20-09
|
||||
[2024-09-22-14-45-22] Operation cancelled by user.
|
||||
[2024-09-22 15:08:02] Moved /home/glenn/.config/test to /home/glenn/.dotfiles/.config/test
|
||||
[2024-09-22 15:08:02] Symlink created at /home/glenn/.config/test pointing to /home/glenn/.dotfiles/.config/test
|
||||
[2024-09-22-15-10-35] Operation cancelled by user.
|
||||
[2024-09-22-15-11-04] Moved /home/glenn/.config/test to /home/glenn/.dotfiles/.config/test
|
||||
[2024-09-22-15-11-04] Symlink created at /home/glenn/.config/test pointing to /home/glenn/.dotfiles/.config/test
|
||||
[2024-09-22-15-11-19] Operation cancelled by user.
|
||||
[2024-09-27-12-35-30] Moved /home/glenn/.config/fastfetch/ to /home/glenn/.dotfiles/.config/fastfetch/
|
||||
[2024-09-27-12-37-59] Moved /home/glenn/.config/variety to /home/glenn/.dotfiles/.config/variety
|
||||
[2024-09-27-12-37-59] Symlink created at /home/glenn/.config/variety pointing to /home/glenn/.dotfiles/.config/variety
|
||||
[2024-09-27-12-41-42] Moved /home/glenn/.password-store to /home/glenn/.dotfiles//.password-store
|
||||
[2024-09-27-12-41-42] Symlink created at /home/glenn/.password-store pointing to /home/glenn/.dotfiles//.password-store
|
||||
[2024-10-04-09-23-18] Moved /home/glenn/.config/alacritty/test/ to /home/glenn/.dotfiles//test/
|
||||
[2024-10-04-09-28-04] Moved /home/glenn/.config/test to /home/glenn/.dotfiles//test
|
||||
[2024-10-04-09-28-04] Symlink created at /home/glenn/.config/test pointing to /home/glenn/.dotfiles//test
|
||||
[2024-10-04-09-38-56] Moved /home/glenn/.config/test to /home/glenn/.dotfiles//test
|
||||
[2024-10-04-09-38-56] Symlink created at /home/glenn/.config/test pointing to /home/glenn/.dotfiles//test
|
||||
[2024-10-04-09-44-28] Conflict: Directory /home/glenn/.dotfiles//.config already exists
|
||||
[2024-10-04-09-44-28] Conflict: Symlink /home/glenn/.config/test already exists
|
||||
[2024-10-04-09-45-21] Conflict: Directory /home/glenn/.dotfiles//.config already exists
|
||||
[2024-10-04-09-45-21] Conflict: Symlink /home/glenn/.config/test already exists
|
||||
[2024-10-04-09-49-29] Moved /home/glenn/.config/test to /home/glenn/.dotfiles//.config/test
|
||||
[2024-10-04-09-49-29] Symlink created at /home/glenn/.config/test pointing to /home/glenn/.dotfiles//.config/test
|
||||
[2024-10-04-09-50-37] Conflict: Directory /home/glenn/.dotfiles//.config/test already exists
|
||||
[2024-10-04-09-50-37] Conflict: Symlink /home/glenn/.config/test already exists
|
||||
[2024-10-04-09-50-58] Conflict: Directory /home/glenn/.dotfiles//.config/test already exists
|
||||
[2024-10-04-09-50-58] Conflict: Symlink /home/glenn/.config/test already exists
|
||||
[2024-10-04-10-03-19] Moved /home/glenn/.config/test to /home/glenn/.dotfiles//.config/test
|
||||
[2024-10-04-10-03-19] Symlink created at /home/glenn/.config/test pointing to /home/glenn/.dotfiles//.config/test
|
||||
[2024-10-04-10-03-26] Operation cancelled by user.
|
||||
[2024-10-04-10-08-56] Operation cancelled by user.
|
||||
[2024-10-04-10-09-27] Moved /home/glenn/.config/test to /home/glenn/.dotfiles//.config/test
|
||||
[2024-10-04-10-09-27] Symlink created at /home/glenn/.config/test pointing to /home/glenn/.dotfiles//.config/test
|
||||
[2024-10-04-10-14-57] Moved /home/glenn/.config/test to /home/glenn/.dotfiles/.config/test
|
||||
[2024-10-04-10-14-57] Symlink created at /home/glenn/.config/test pointing to /home/glenn/.dotfiles/.config/test
|
||||
[2024-10-04-10-15-00] Operation cancelled by user.
|
||||
[2024-10-04-10-18-57] Operation cancelled by user.
|
||||
[2024-10-04-12-40-06] Moved /home/glenn/.config/test to /home/glenn/.dotfiles/.config/test
|
||||
[2024-10-04-12-40-06] Symlink created at /home/glenn/.config/test pointing to /home/glenn/.dotfiles/.config/test
|
||||
[2024-10-04-12-40-11] Operation cancelled by user.
|
||||
[2024-10-04-12-43-41] Moved /home/glenn/.config/test to /home/glenn/.dotfiles/.config/test
|
||||
[2024-10-04-12-43-41] Symlink created at /home/glenn/.config/test pointing to /home/glenn/.dotfiles/.config/test
|
||||
[2024-10-04-12-43-45] Operation cancelled by user.
|
||||
[2024-10-04-12-46-28] Operation cancelled by user.
|
||||
[2024-10-04-12-46-43] Skipped moving directory: /home/glenn/.dotfiles/.config/test
|
||||
[2024-10-04-12-46-48] Operation cancelled by user.
|
||||
[32m[2024-10-04-14-39-19] Operation cancelled by user.[0m
|
||||
|
|
|
|||
390
stash.scm
390
stash.scm
|
|
@ -34,43 +34,221 @@
|
|||
;;; Code:
|
||||
|
||||
;; Import necessary modules
|
||||
;; (use-modules (ice-9 getopt-long)
|
||||
;; (ice-9 popen)
|
||||
;; (ice-9 rdelim)
|
||||
;; (ice-9 format)
|
||||
;; (stash-help) ;; Import the stash-help module for help functionality
|
||||
;; (srfi srfi-1)
|
||||
;; (srfi srfi-19)) ;; Use for list handling and date-time formatting
|
||||
|
||||
;; ;;; 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))
|
||||
|
||||
;; ;;; Helper function to get a formatted current time string
|
||||
;; (define (current-timestamp)
|
||||
;; "Return the current date and time as a formatted string."
|
||||
;; (let* ((time (current-time))
|
||||
;; (seconds (time-second time)))
|
||||
;; (strftime "%Y-%m-%d-%H-%M-%S" (localtime seconds))))
|
||||
|
||||
;; ;;; Improved logging function with timestamp
|
||||
;; (define (log-action message)
|
||||
;; "Log an action with a timestamp to the stash.log file."
|
||||
;; (let ((log-port (open-file "stash.log" "a"))) ;; Open file in append mode
|
||||
;; (display (string-append "[" (current-timestamp) "] " message) log-port)
|
||||
;; (newline log-port)
|
||||
;; (close-port log-port)))
|
||||
|
||||
;; ;;; Version function
|
||||
;; (define (display-version)
|
||||
;; "Display the current version of the program."
|
||||
;; (display (format #f "Stash version ~a\n" "0.1.0-alpha.1"))
|
||||
;; (exit 0))
|
||||
|
||||
;; ;;; Helper function to check for version flag and display version
|
||||
;; (define (check-for-version args)
|
||||
;; "Check if --version or -v is in the arguments list."
|
||||
;; (if (or (member "--version" args)
|
||||
;; (member "-v" args))
|
||||
;; (display-version)))
|
||||
|
||||
;; ;;; Expand ~ in paths to the full home directory path
|
||||
;; (define (expand-home path)
|
||||
;; "Expand ~ to the user's home directory."
|
||||
;; (if (string-prefix? "~" path)
|
||||
;; (string-append (getenv "HOME") (substring path 1))
|
||||
;; path))
|
||||
|
||||
;; ;;; Helper function to concatenate paths safely
|
||||
;; (define (concat-path base path)
|
||||
;; "Concatenate two paths, ensuring there are no double slashes."
|
||||
;; (if (string-suffix? "/" base)
|
||||
;; (string-append (string-drop-right base 1) "/" path)
|
||||
;; (string-append base "/" path)))
|
||||
|
||||
;; ;;; Conflict resolution handler with user options
|
||||
;; (define (prompt-user-for-action)
|
||||
;; "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 "c") 'cancel)
|
||||
;; (else
|
||||
;; (display (color-message "Invalid input. Please try again.\n" red-text))
|
||||
;; (prompt-user-for-action)))))
|
||||
|
||||
;; ;;; Helper function to delete a directory recursively
|
||||
;; (define (delete-directory path)
|
||||
;; "Delete a directory recursively."
|
||||
;; (if (file-is-directory? path)
|
||||
;; (begin
|
||||
;; (system (string-append "rm -rf " (shell-quote-argument path)))
|
||||
;; (log-action (format #f "Deleted directory: ~a" path)))
|
||||
;; (display (color-message "Error: Path is not a directory.\n" red-text))))
|
||||
|
||||
;; ;;; Helper function to handle conflicts
|
||||
;; (define (handle-conflict target-source-dir source-dir)
|
||||
;; "Handle conflicts when the target directory already exists."
|
||||
;; (let ((choice (prompt-user-for-action)))
|
||||
;; (cond
|
||||
;; ((eq? choice 'overwrite)
|
||||
;; (delete-directory target-source-dir)
|
||||
;; (rename-file source-dir target-source-dir)
|
||||
;; (display (color-message (format #f "Overwriting directory ~a.\n" target-source-dir) green-text))
|
||||
;; (log-action (format #f "Overwritten directory: ~a" target-source-dir)))
|
||||
;; ((eq? choice 'skip)
|
||||
;; (display (color-message "Skipping move operation.\n" green-text))
|
||||
;; (log-action (format #f "Skipped moving directory: ~a" target-source-dir)))
|
||||
;; ((eq? choice 'cancel)
|
||||
;; (display (color-message "Operation cancelled by user.\n" yellow-text))
|
||||
;; (log-action "Operation cancelled by user.")
|
||||
;; (exit 0)))))
|
||||
|
||||
;; ;;; Helper function to ensure target has .config appended, avoiding double slashes
|
||||
;; (define (ensure-config-path target-dir)
|
||||
;; "Ensure that the target directory has .config appended, avoiding double slashes."
|
||||
;; (let ((target-dir (expand-home target-dir)))
|
||||
;; (if (string-suffix? "/" target-dir)
|
||||
;; (set! target-dir (string-drop-right target-dir 1))) ;; Remove trailing slash if it exists
|
||||
;; (if (not (string-suffix? "/.config" target-dir))
|
||||
;; (string-append target-dir "/.config")
|
||||
;; target-dir)))
|
||||
|
||||
;; ;;; Helper function to move source to target
|
||||
;; (define (move-source-to-target source-dir target-dir)
|
||||
;; "Move the entire source directory to the target directory, ensuring .config in the target path."
|
||||
;; (let* ((target-dir (ensure-config-path target-dir))
|
||||
;; (source-dir (expand-home source-dir))
|
||||
;; (source-name (basename source-dir))
|
||||
;; (target-source-dir (concat-path target-dir source-name)))
|
||||
;; ;; Ensure that the .config directory exists in the target
|
||||
;; (if (not (file-exists? target-dir))
|
||||
;; (mkdir target-dir #o755))
|
||||
;; ;; Check if the target directory already exists
|
||||
;; (if (file-exists? target-source-dir)
|
||||
;; (handle-conflict target-source-dir source-dir)
|
||||
;; ;; If the target directory doesn't exist, proceed with the move
|
||||
;; (begin
|
||||
;; (rename-file source-dir target-source-dir)
|
||||
;; (display (color-message (format #f "Moved ~a to ~a\n" source-dir target-source-dir) green-text))
|
||||
;; (log-action (format #f "Moved ~a to ~a" source-dir target-source-dir))))
|
||||
;; target-source-dir)) ;; Return the path of the moved source directory
|
||||
|
||||
;; ;;; Helper function to create a symlink in the parent directory of the original source
|
||||
;; (define (create-symlink-in-parent source-dir target-dir)
|
||||
;; "Create a symlink in the parent directory of source-dir."
|
||||
;; (let* ((parent-dir (expand-home (dirname source-dir))) ;; Ensure the parent path is expanded
|
||||
;; (symlink-target (concat-path parent-dir (basename source-dir)))
|
||||
;; (target-dir (expand-home target-dir))) ;; Ensure the target path is expanded
|
||||
;; ;; Check if symlink already exists
|
||||
;; (if (file-exists? symlink-target)
|
||||
;; (let ((choice (prompt-user-for-action)))
|
||||
;; (cond
|
||||
;; ((eq? choice 'overwrite)
|
||||
;; (delete-file symlink-target)
|
||||
;; (symlink target-dir symlink-target)
|
||||
;; (display (color-message (format #f "Overwriting symlink ~a pointing to ~a\n" symlink-target target-dir) green-text))
|
||||
;; (log-action (format #f "Overwritten symlink: ~a pointing to ~a" symlink-target target-dir)))
|
||||
;; ((eq? choice 'skip)
|
||||
;; (display (color-message "Skipping symlink creation.\n" green-text))
|
||||
;; (log-action (format #f "Skipped symlink creation: ~a" symlink-target)))
|
||||
;; ((eq? choice 'cancel)
|
||||
;; (display (color-message "Operation cancelled by user.\n" yellow-text))
|
||||
;; (log-action "Operation cancelled by user.")
|
||||
;; (exit 0))))
|
||||
;; ;; Create the symlink if no conflict
|
||||
;; (begin
|
||||
;; (symlink target-dir symlink-target)
|
||||
;; (display (color-message (format #f "Symlink created at ~a pointing to ~a\n" symlink-target target-dir) green-text))
|
||||
;; (log-action (format #f "Symlink created at ~a pointing to ~a" symlink-target target-dir))))))
|
||||
|
||||
;; ;;; Main function to handle source and target operations
|
||||
;; (define (handle-source-and-target source-dir target-dir)
|
||||
;; "Move the source directory to the target and create a symlink in the parent directory."
|
||||
;; (let ((target-source-dir (move-source-to-target source-dir target-dir))) ;; Move the directory
|
||||
;; (create-symlink-in-parent source-dir target-source-dir))) ;; Create the symlink
|
||||
|
||||
;; ;;; Function to handle command-line arguments
|
||||
;; (define (parse-arguments args)
|
||||
;; "Parse command-line arguments."
|
||||
;; (getopt-long args
|
||||
;; '((target (value #t) (single-char #\t)) ;; Support both --target and -t
|
||||
;; (source (value #t) (single-char #\s)) ;; Support both --source and -s
|
||||
;; (help (value #f) (single-char #\h)) ;; Support -h for help
|
||||
;; (version (value #f) (single-char #\v))))) ;; Support -v for version
|
||||
|
||||
;; ;;; Main entry point
|
||||
;; (define (main args)
|
||||
;; "Main function to parse arguments and execute the program."
|
||||
;; (setenv "GUILE_AUTO_COMPILE" "0")
|
||||
;; ;; Check if --help or -h was passed
|
||||
;; (if (or (member "--help" args) (member "-h" args))
|
||||
;; (display-help))
|
||||
|
||||
;; ;; Check if --version or -v was passed
|
||||
;; (check-for-version args)
|
||||
|
||||
;; ;; Parse remaining arguments
|
||||
;; (let* ((options (parse-arguments args))
|
||||
;; (target-dir (assoc-ref options 'target))
|
||||
;; (source-dir (assoc-ref options 'source)))
|
||||
;; (if (and target-dir source-dir)
|
||||
;; (handle-source-and-target source-dir target-dir)
|
||||
;; (begin
|
||||
;; (display (color-message "Error: Missing required arguments.\n" red-text))
|
||||
;; (display (color-message "Usage: stash.scm --target=<target-dir> --source=<source-dir>\n" yellow-text))
|
||||
;; (exit 1)))))
|
||||
|
||||
;; ;; Entry point for stash
|
||||
;; (main (command-line))
|
||||
|
||||
;; stash.scm --- Main script for moving directories and creating symlinks with conflict resolution
|
||||
|
||||
(use-modules (ice-9 getopt-long)
|
||||
(ice-9 popen)
|
||||
(ice-9 rdelim)
|
||||
(ice-9 format)
|
||||
(stash-help) ;; Import the stash-help module for help functionality
|
||||
(stash help) ;; Help module
|
||||
(stash colors) ;; ANSI colors
|
||||
(stash log) ;; Logging module
|
||||
(stash paths) ;; Path handling module
|
||||
(stash conflict) ;; Conflict resolution module
|
||||
(stash file-ops) ;; File and symlink operations module
|
||||
(srfi srfi-1)
|
||||
(srfi srfi-19)) ;; Use for list handling and date-time formatting
|
||||
|
||||
;;; 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))
|
||||
|
||||
;;; Helper function to get a formatted current time string
|
||||
(define (current-timestamp)
|
||||
"Return the current date and time as a formatted string."
|
||||
(let* ((time (current-time))
|
||||
(seconds (time-second time)))
|
||||
(strftime "%Y-%m-%d-%H-%M-%S" (localtime seconds))))
|
||||
|
||||
;;; Improved logging function with timestamp
|
||||
(define (log-action message)
|
||||
"Log an action with a timestamp to the stash.log file."
|
||||
(let ((log-port (open-file "stash.log" "a"))) ;; Open file in append mode
|
||||
(display (string-append "[" (current-timestamp) "] " message) log-port)
|
||||
(newline log-port)
|
||||
(close-port log-port)))
|
||||
(srfi srfi-19))
|
||||
|
||||
;;; Version function
|
||||
(define (display-version)
|
||||
"Display the current version of the program."
|
||||
(display (format #f "Stash version ~a\n" "0.1.0-alpha.1"))
|
||||
(newline)
|
||||
(display "Stash version 0.1.0-alpha.1\n")
|
||||
(exit 0))
|
||||
|
||||
;;; Helper function to check for version flag and display version
|
||||
|
|
@ -80,123 +258,11 @@
|
|||
(member "-v" args))
|
||||
(display-version)))
|
||||
|
||||
;;; Expand ~ in paths to the full home directory path
|
||||
(define (expand-home path)
|
||||
"Expand ~ to the user's home directory."
|
||||
(if (string-prefix? "~" path)
|
||||
(string-append (getenv "HOME") (substring path 1))
|
||||
path))
|
||||
|
||||
;;; Helper function to concatenate paths safely
|
||||
(define (concat-path base path)
|
||||
"Concatenate two paths, ensuring there are no double slashes."
|
||||
(if (string-suffix? "/" base)
|
||||
(string-append (string-drop-right base 1) "/" path)
|
||||
(string-append base "/" path)))
|
||||
|
||||
;;; Conflict resolution handler with user options
|
||||
(define (prompt-user-for-action)
|
||||
"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 "c") 'cancel)
|
||||
(else
|
||||
(display (color-message "Invalid input. Please try again.\n" red-text))
|
||||
(prompt-user-for-action)))))
|
||||
|
||||
;;; Helper function to delete a directory recursively
|
||||
(define (delete-directory path)
|
||||
"Delete a directory recursively."
|
||||
(if (file-is-directory? path)
|
||||
(begin
|
||||
(system (string-append "rm -rf " (shell-quote-argument path)))
|
||||
(log-action (format #f "Deleted directory: ~a" path)))
|
||||
(display (color-message "Error: Path is not a directory.\n" red-text))))
|
||||
|
||||
;;; Helper function to handle conflicts
|
||||
(define (handle-conflict target-source-dir source-dir)
|
||||
"Handle conflicts when the target directory already exists."
|
||||
(let ((choice (prompt-user-for-action)))
|
||||
(cond
|
||||
((eq? choice 'overwrite)
|
||||
(delete-directory target-source-dir)
|
||||
(rename-file source-dir target-source-dir)
|
||||
(display (color-message (format #f "Overwriting directory ~a.\n" target-source-dir) green-text))
|
||||
(log-action (format #f "Overwritten directory: ~a" target-source-dir)))
|
||||
((eq? choice 'skip)
|
||||
(display (color-message "Skipping move operation.\n" green-text))
|
||||
(log-action (format #f "Skipped moving directory: ~a" target-source-dir)))
|
||||
((eq? choice 'cancel)
|
||||
(display (color-message "Operation cancelled by user.\n" yellow-text))
|
||||
(log-action "Operation cancelled by user.")
|
||||
(exit 0)))))
|
||||
|
||||
;;; Helper function to ensure target has .config appended, avoiding double slashes
|
||||
(define (ensure-config-path target-dir)
|
||||
"Ensure that the target directory has .config appended, avoiding double slashes."
|
||||
(let ((target-dir (expand-home target-dir)))
|
||||
(if (string-suffix? "/" target-dir)
|
||||
(set! target-dir (string-drop-right target-dir 1))) ;; Remove trailing slash if it exists
|
||||
(if (not (string-suffix? "/.config" target-dir))
|
||||
(string-append target-dir "/.config")
|
||||
target-dir)))
|
||||
|
||||
;;; Helper function to move source to target
|
||||
(define (move-source-to-target source-dir target-dir)
|
||||
"Move the entire source directory to the target directory, ensuring .config in the target path."
|
||||
(let* ((target-dir (ensure-config-path target-dir))
|
||||
(source-dir (expand-home source-dir))
|
||||
(source-name (basename source-dir))
|
||||
(target-source-dir (concat-path target-dir source-name)))
|
||||
;; Ensure that the .config directory exists in the target
|
||||
(if (not (file-exists? target-dir))
|
||||
(mkdir target-dir #o755))
|
||||
;; Check if the target directory already exists
|
||||
(if (file-exists? target-source-dir)
|
||||
(handle-conflict target-source-dir source-dir)
|
||||
;; If the target directory doesn't exist, proceed with the move
|
||||
(begin
|
||||
(rename-file source-dir target-source-dir)
|
||||
(display (color-message (format #f "Moved ~a to ~a\n" source-dir target-source-dir) green-text))
|
||||
(log-action (format #f "Moved ~a to ~a" source-dir target-source-dir))))
|
||||
target-source-dir)) ;; Return the path of the moved source directory
|
||||
|
||||
;;; Helper function to create a symlink in the parent directory of the original source
|
||||
(define (create-symlink-in-parent source-dir target-dir)
|
||||
"Create a symlink in the parent directory of source-dir."
|
||||
(let* ((parent-dir (expand-home (dirname source-dir))) ;; Ensure the parent path is expanded
|
||||
(symlink-target (concat-path parent-dir (basename source-dir)))
|
||||
(target-dir (expand-home target-dir))) ;; Ensure the target path is expanded
|
||||
;; Check if symlink already exists
|
||||
(if (file-exists? symlink-target)
|
||||
(let ((choice (prompt-user-for-action)))
|
||||
(cond
|
||||
((eq? choice 'overwrite)
|
||||
(delete-file symlink-target)
|
||||
(symlink target-dir symlink-target)
|
||||
(display (color-message (format #f "Overwriting symlink ~a pointing to ~a\n" symlink-target target-dir) green-text))
|
||||
(log-action (format #f "Overwritten symlink: ~a pointing to ~a" symlink-target target-dir)))
|
||||
((eq? choice 'skip)
|
||||
(display (color-message "Skipping symlink creation.\n" green-text))
|
||||
(log-action (format #f "Skipped symlink creation: ~a" symlink-target)))
|
||||
((eq? choice 'cancel)
|
||||
(display (color-message "Operation cancelled by user.\n" yellow-text))
|
||||
(log-action "Operation cancelled by user.")
|
||||
(exit 0))))
|
||||
;; Create the symlink if no conflict
|
||||
(begin
|
||||
(symlink target-dir symlink-target)
|
||||
(display (color-message (format #f "Symlink created at ~a pointing to ~a\n" symlink-target target-dir) green-text))
|
||||
(log-action (format #f "Symlink created at ~a pointing to ~a" symlink-target target-dir))))))
|
||||
|
||||
;;; Main function to handle source and target operations
|
||||
(define (handle-source-and-target source-dir target-dir)
|
||||
"Move the source directory to the target and create a symlink in the parent directory."
|
||||
(let ((target-source-dir (move-source-to-target source-dir target-dir))) ;; Move the directory
|
||||
(create-symlink-in-parent source-dir target-source-dir))) ;; Create the symlink
|
||||
(let ((target-source-dir (move-source-to-target source-dir target-dir))) ;; Only pass source-dir and target-dir
|
||||
(create-symlink-in-parent source-dir target-source-dir))) ;; Create the symlink if no conflict
|
||||
|
||||
;;; Function to handle command-line arguments
|
||||
(define (parse-arguments args)
|
||||
|
|
@ -210,7 +276,8 @@
|
|||
;;; Main entry point
|
||||
(define (main args)
|
||||
"Main function to parse arguments and execute the program."
|
||||
(setenv "GUILE_AUTO_COMPILE" "0")
|
||||
(setenv "GUILE_AUTO_COMPILE" "0") ;; Disable auto-compilation for performance
|
||||
|
||||
;; Check if --help or -h was passed
|
||||
(if (or (member "--help" args) (member "-h" args))
|
||||
(display-help))
|
||||
|
|
@ -218,16 +285,27 @@
|
|||
;; Check if --version or -v was passed
|
||||
(check-for-version args)
|
||||
|
||||
;; Parse remaining arguments
|
||||
(let* ((options (parse-arguments args))
|
||||
(target-dir (assoc-ref options 'target))
|
||||
(source-dir (assoc-ref options 'source)))
|
||||
(if (and target-dir source-dir)
|
||||
(handle-source-and-target source-dir target-dir)
|
||||
(begin
|
||||
(display (color-message "Error: Missing required arguments.\n" red-text))
|
||||
(display (color-message "Usage: stash.scm --target=<target-dir> --source=<source-dir>\n" yellow-text))
|
||||
(exit 1)))))
|
||||
;;; Parse remaining arguments
|
||||
(let* ((options (parse-arguments args)) ;; Parse the command-line options
|
||||
(target-dir (assoc-ref options 'target)) ;; Extract --target or -t argument
|
||||
(source-dir (assoc-ref options 'source))) ;; Extract --source or -s argument
|
||||
(if (and target-dir source-dir) ;; Ensure both arguments are provided
|
||||
(handle-source-and-target source-dir target-dir) ;; Proceed with moving the directory and creating the symlink
|
||||
(begin
|
||||
(display (color-message "Error: Missing required arguments.\n" red-text)) ;; Show error in red text
|
||||
(display (color-message "Usage: stash.scm --target <target-dir> --source <source-dir>\n" yellow-text)) ;; Show updated usage message
|
||||
(exit 1))))) ;; Exit with error status
|
||||
|
||||
;; ;; Parse remaining arguments
|
||||
;; (let* ((options (parse-arguments args))
|
||||
;; (target-dir (assoc-ref options 'target))
|
||||
;; (source-dir (assoc-ref options 'source)))
|
||||
;; (if (and target-dir source-dir)
|
||||
;; (handle-source-and-target source-dir target-dir) ;; Handle the source move and symlink creation
|
||||
;; (begin
|
||||
;; (display "Error: Missing required arguments.\n")
|
||||
;; (display "Usage: stash.scm --target=<target-dir> --source=<source-dir>\n")
|
||||
;; (exit 1)))))
|
||||
|
||||
;; Entry point for stash
|
||||
(main (command-line))
|
||||
|
|
|
|||
Loading…
Reference in New Issue