glenn
/
stash
mirror of https://codeberg.org/glenneth/stash.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Created modules from main scm file

This commit is contained in:
GLENN THOMPSON 2024-10-04 14:40:34 +03:00
parent c61aa562da
commit f5c89a0b71
8 changed files with 535 additions and 224 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
modules/stash/colors.scm Normal file
View File

@ -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))

76
modules/stash/conflict.scm Normal file
View File

@ -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)))))

139
modules/stash/file-ops.scm Normal file
View File

@ -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))))))

2
stash-help.scm → modules/stash/help.scm
View File

@ -1,6 +1,6 @@
;; stash-help.scm --- Help message module for Stash ;; stash-help.scm --- Help message module for Stash
(define-module (stash-help) (define-module (stash help)
#:export (display-help)) #:export (display-help))
;;; Function to display help message ;;; Function to display help message

43
modules/stash/log.scm Normal file
View File

@ -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)))

28
modules/stash/paths.scm Normal file
View File

@ -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
View File

@ -1,67 +1 @@
Moved /home/glenn/.config/test to /home/glenn/.dotfiles/.config/test [2024-10-04-14-39-19] Operation cancelled by user.
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.

390
stash.scm
View File

@ -34,43 +34,221 @@
;;; Code: ;;; Code:
;; Import necessary modules ;; 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) (use-modules (ice-9 getopt-long)
(ice-9 popen) (stash help) ;; Help module
(ice-9 rdelim) (stash colors) ;; ANSI colors
(ice-9 format) (stash log) ;; Logging module
(stash-help) ;; Import the stash-help module for help functionality (stash paths) ;; Path handling module
(stash conflict) ;; Conflict resolution module
(stash file-ops) ;; File and symlink operations module
(srfi srfi-1) (srfi srfi-1)
(srfi srfi-19)) ;; Use for list handling and date-time formatting (srfi srfi-19))
;;; 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 ;;; Version function
(define (display-version) (define (display-version)
"Display the current version of the program." "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)) (exit 0))
;;; Helper function to check for version flag and display version ;;; Helper function to check for version flag and display version
@ -80,123 +258,11 @@
(member "-v" args)) (member "-v" args))
(display-version))) (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 ;;; Main function to handle source and target operations
(define (handle-source-and-target source-dir target-dir) (define (handle-source-and-target source-dir target-dir)
"Move the source directory to the target and create a symlink in the parent directory." "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 (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 (create-symlink-in-parent source-dir target-source-dir))) ;; Create the symlink if no conflict
;;; Function to handle command-line arguments ;;; Function to handle command-line arguments
(define (parse-arguments args) (define (parse-arguments args)
@ -210,7 +276,8 @@
;;; Main entry point ;;; Main entry point
(define (main args) (define (main args)
"Main function to parse arguments and execute the program." "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 ;; Check if --help or -h was passed
(if (or (member "--help" args) (member "-h" args)) (if (or (member "--help" args) (member "-h" args))
(display-help)) (display-help))
@ -218,16 +285,27 @@
;; Check if --version or -v was passed ;; Check if --version or -v was passed
(check-for-version args) (check-for-version args)
;; Parse remaining arguments ;;; Parse remaining arguments
(let* ((options (parse-arguments args)) (let* ((options (parse-arguments args)) ;; Parse the command-line options
(target-dir (assoc-ref options 'target)) (target-dir (assoc-ref options 'target)) ;; Extract --target or -t argument
(source-dir (assoc-ref options 'source))) (source-dir (assoc-ref options 'source))) ;; Extract --source or -s argument
(if (and target-dir source-dir) (if (and target-dir source-dir) ;; Ensure both arguments are provided
(handle-source-and-target source-dir target-dir) (handle-source-and-target source-dir target-dir) ;; Proceed with moving the directory and creating the symlink
(begin (begin
(display (color-message "Error: Missing required arguments.\n" red-text)) (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)) (display (color-message "Usage: stash.scm --target <target-dir> --source <source-dir>\n" yellow-text)) ;; Show updated usage message
(exit 1))))) (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 ;; Entry point for stash
(main (command-line)) (main (command-line))