first commit

1 files changed, 182 insertions, 0 deletions

diff --git a/.emacs.d/lisp/my/my-media-segment.el b/.emacs.d/lisp/my/my-media-segment.el
new file mode 100644
index 0000000..0cef817
--- /dev/null
+++ b/.emacs.d/lisp/my/my-media-segment.el
@@ -0,0 +1,182 @@
+;;; my-media-segment.el -- Media segmentation utility -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023 Free Software Foundation.
+
+;; Author: Yuchen Pei <id@ypei.org>
+;; Package-Requires: ((emacs "28.2"))
+
+;; This file is part of dotfiles.
+
+;; dotfiles is free software: you can redistribute it and/or modify it under
+;; the terms of the GNU Affero General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; dotfiles is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Affero General
+;; Public License for more details.
+
+;; You should have received a copy of the GNU Affero General Public
+;; License along with dotfiles.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Media segmentation utility.
+
+;;; Code:
+
+
+
+;;; A utility using ffmpeg to cut a media file into smaller ones, from a
+;;; description of the timestamps.
+(defvar my-media-segment-queued-jobs nil)
+(defvar my-media-segment-max-inflight 3)
+
+(defun my-media-segment-enqueue-process (start-process-function)
+  "Enqueue a process that can started by applying 'start-process'.
+
+The process can be started by applying 'start-process' on START-PROCESS-ARGS."
+  ;; somehow only this version works, but not nconc or setq with append
+  ;; the problem with the other two is that the operation gets stuck after the
+  ;; initial 'my-media-segment-max-inflight' operations.
+  (add-to-list 'my-media-segment-queued-jobs start-process-function)
+  ;; (nconc my-media-segment-queued-jobs (list start-process-function))
+  ;; (setq my-media-segment-queued-jobs
+  ;;       (append my-media-segment-queued-jobs (list start-process-function)))
+  )
+
+(defun my-media-segment-dequeue-process ()
+  (when my-media-segment-queued-jobs
+    (funcall (pop my-media-segment-queued-jobs))))
+
+(defun my-segment-media-file-1 (media-file-name desc-file-name)
+  "Run ffmpeg asynchronously to segment file-name according to description.
+
+Uses `my-media-segment-max-inflight' to limit number of inflight tasks."
+  (interactive (list
+                (read-file-name "Choose media file: ")
+                (read-file-name "Choose description file: ")))
+  (let* ((dir (file-name-sans-extension (expand-file-name media-file-name)))
+         (info (my-get-media-segments
+                (with-temp-buffer
+                  (insert-file-contents desc-file-name)
+                  (buffer-string))))
+         (total (length info))
+         (idx 0)
+         (thunk))
+    (dolist (media info)
+      (setq idx (1+ idx))
+      (ignore-errors (dired-create-directory dir))
+      (let* ((title (plist-get media :title))
+             (start (plist-get media :start))
+             (end (plist-get media :end))
+             (args (append (list "-ss" start)
+                           (when end (list "-to" end))
+                           (list "-i" (expand-file-name media-file-name)
+                                 (format "%s/%s.%s" dir title
+                                         (file-name-extension media-file-name))))))
+        (setq thunk
+              (lambda ()
+                (message "Cutting %s-%s to %s (%d/%d)..."
+                         start (or end "") title idx total)
+                (set-process-sentinel
+                 (apply 'start-process
+                        (append (list (format "ffmpeg-%s" title)
+                                      (format "*ffmpeg-%s*" title)
+                                      "ffmpeg")
+                                args))
+                 (lambda (_ _)
+                   (my-media-segment-dequeue-process)))))
+        (if (<= idx my-media-segment-max-inflight)
+            (funcall thunk)
+          (my-media-segment-enqueue-process thunk))))))
+
+(defun my-get-media-segments (description)
+  "Output title start end triplets."
+  (let ((results) (title) (start) (end))
+    (with-temp-buffer
+      (erase-buffer)
+      (insert description)
+      (goto-char (point-min))
+      (save-excursion
+        (while (re-search-forward
+                "\\(\\(?:[0-9]+:\\)?[0-9]+:[0-9]\\{2\\}\\)\\(?:[[:space:]]*-[[:space:]]*\\(\\(?:[0-9]+:\\)?[0-9]+:[0-9]\\{2\\}\\)\\)?"
+                nil t)
+          (setq start (match-string-no-properties 1)
+                end (match-string-no-properties 2))
+          (replace-match "")
+          (beginning-of-line 1)
+          (setq title (replace-regexp-in-string
+                       "^[[:punct:][:space:]]*" ""
+                       (replace-regexp-in-string
+                        "[[:punct:][:space:]]*$" ""
+                        (buffer-substring-no-properties
+                         (point)
+                         (progn (beginning-of-line 2) (point))))))
+          (push (list :title (my-make-filename title) :start start :end end) results)
+          )
+        (setq end nil)
+        (dolist (result results)
+          (unless (plist-get result :end)
+            (plist-put result :end end)
+            (setq end (plist-get result :start))))
+        (reverse results))
+      )))
+
+(defvar my-segment-media-max-async 10)
+(defun my-segment-media-file (media-file-name desc-file-name synchronously)
+  "Run ffmpeg asynchronously to segment file-name according to description.
+
+With a prefix-arg, run synchronously."
+  (interactive (list
+                (read-file-name "Choose media file: ")
+                (read-file-name "Choose description file: ")
+                current-prefix-arg))
+  (let* ((dir (file-name-sans-extension (expand-file-name media-file-name)))
+         (info (my-get-media-segments
+                (with-temp-buffer
+                  (insert-file-contents desc-file-name)
+                  (buffer-string))))
+         (total (length info))
+         (idx 0))
+    (when (or synchronously (<= total my-segment-media-max-async)
+              (let ((choice
+                     (car
+                      (read-multiple-choice
+                       (format
+                        "Recognised many (%d) segments, continue asynchronously?"
+                        total)
+                       '((?y "yes")
+                         (?s "synchronously instead")
+                         (?n "cancel"))))))
+                (cond ((eq choice ?y) t)
+                      ((eq choice ?s) (setq synchronously t))
+                      (t nil))))
+      (dolist (media info)
+        (setq idx (1+ idx))
+        (ignore-errors (dired-create-directory dir))
+        (let* ((title (plist-get media :title))
+               (start (plist-get media :start))
+               (end (plist-get media :end))
+               (args (append (list "-ss" start)
+                             (when end (list "-to" end))
+                             (list "-i" (expand-file-name media-file-name)
+                                   (format "%s/%s.%s" dir title
+                                           (file-name-extension media-file-name))))))
+          (message "Cutting %s-%s to %s (%d/%d)..."
+                   start (or end "") title idx total)
+          (if synchronously
+              (apply 'call-process
+                     (append (list "ffmpeg" nil "*ffmpeg*" t) args))
+            (apply 'start-process
+                   (append (list (format "ffmpeg-%s" title)
+                                 (format "*ffmpeg-%s*" title)
+                                 "ffmpeg")
+                           args)))))
+      (when synchronously
+        (message "All %d segments splitted into %s"
+                 (length info) dir)))))
+
+(provide 'my-media-segment)
+;;; my-media-segment.el ends here