1 files changed, 70 insertions, 1 deletions

diff --git a/emacs/.emacs.d/lisp/my/my-utils.el b/emacs/.emacs.d/lisp/my/my-utils.el
index bc200c2..3ecd0a9 100644
--- a/emacs/.emacs.d/lisp/my/my-utils.el
+++ b/emacs/.emacs.d/lisp/my/my-utils.el
@@ -321,7 +321,7 @@ Example: (format-time-string ... (my-time-from-epoch 1698582504))"
 
 (defvar my-extension-types
   '((audio . ("asf" "cue" "flac" "m4a" "m4r" "mid" "mp3" "ogg" "opus"
-              "wav" "wma" "spc"))
+              "wav" "wma" "spc" "mp4"))
     (video . ("avi" "m4v" "mkv" "mp4" "mpg" "ogg" "ogv" "rmvb" "webm" "wmv"))))
 
 ;;; files
@@ -332,6 +332,75 @@ Example: (format-time-string ... (my-time-from-epoch 1698582504))"
   (make-symbolic-link newname file ok-if-already-exists)
   newname)
 
+(defvar my-copy-file-targets nil
+  "Alist of targets to copy attached to, in the form of (name dest staging)")
+
+(defun my-copy-buffer-file-with-staging ()
+  (interactive)
+  (unless (buffer-file-name) (error "buffer-file-name is nil"))
+  (pcase-let* ((name
+                (completing-read (format "Copy %s to: " (buffer-file-name))
+                                 my-copy-file-targets
+                                 nil t))
+               (`(,dest ,staging) (alist-get name my-copy-file-targets
+                                             nil nil #'equal)))
+    (my-copy-file-with-staging
+     (buffer-file-name) dest staging)))
+
+(defun my-flush-staging-files (staging dest)
+  "Flush files from STAGING to DEST."
+  (dolist (staged (directory-files staging))
+    (unless (file-directory-p (file-name-concat staging staged))
+      (message "Moving staged %s to %s..." staged dest)
+      (copy-file (file-name-concat staging staged)
+		             (file-name-concat dest staged)
+                 t)
+      (delete-file (file-name-concat staging staged)))))
+
+(defun my-flush-staging-files-x ()
+  (interactive)
+  (pcase-let* ((name
+                (completing-read (format "Copy %s to: " (buffer-file-name))
+                                 my-copy-file-targets
+                                 nil t))
+               (`(,dest ,staging) (alist-get name my-copy-file-targets
+                                             nil nil #'equal)))
+    (my-flush-staging-files staging dest)))
+
+(defun my-copy-file-with-staging (src dest staging)
+  "Copy a file SRC to DEST with fallback to hardlinking to STAGING."
+  (my-copy-files-with-staging (list src) dest staging))
+
+(defun my-copy-files-with-staging (src dest staging)
+  "Copy a list of file SRC to DEST with staging.
+
+DEST and STAGING should be directories.
+On failure, hard link to STAGING.
+On success, also move everything from STAGING to DEST."
+  (cl-assert (listp src))
+  (let (failed)
+    (dolist (file src)
+      (cond
+       ((not failed)
+        (message "Copying %s to %s..." file dest)
+        (condition-case err
+            (copy-file
+             file (file-name-concat dest (file-name-nondirectory file)) t)
+          (error
+           (message "Encountered error while copying: %s"
+                    (error-message-string err))
+           (message "Hardlinking instead %s to staging area %s" src staging)
+           (setq failed t)
+           (add-name-to-file
+            file  (file-name-concat staging (file-name-nondirectory file)) t))))
+       (t
+        (message "Hardlinking %s staging area %s" src staging)
+        (add-name-to-file
+         file (file-name-concat staging (file-name-nondirectory file)) t))))
+    (unless failed
+      (my-flush-staging-files staging dest))
+    (message "Done!")))
+
 (defun my-rewrite-url-advice (args)
   (let ((url (car args)))
     (setcar args (my-rewrite-url url)))