From 093ffa5fbf7143f4668bb0a3dc9659a5cc836e12 Mon Sep 17 00:00:00 2001 From: Yuchen Pei Date: Sat, 17 Jun 2023 17:20:29 +1000 Subject: Moving things one level deeper To ease gnu stow usage. Now we can do stow -t ~ emacs --- emacs/.emacs.d/lisp/my/my-media-segment.el | 182 +++++++++++++++++++++++++++++ 1 file changed, 182 insertions(+) create mode 100644 emacs/.emacs.d/lisp/my/my-media-segment.el (limited to 'emacs/.emacs.d/lisp/my/my-media-segment.el') diff --git a/emacs/.emacs.d/lisp/my/my-media-segment.el b/emacs/.emacs.d/lisp/my/my-media-segment.el new file mode 100644 index 0000000..0cef817 --- /dev/null +++ b/emacs/.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 +;; 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 . + +;;; 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 -- cgit v1.2.3