diff options
Diffstat (limited to '.emacs.d/lisp/my/my-media-segment.el')
| -rw-r--r-- | .emacs.d/lisp/my/my-media-segment.el | 182 |
1 files changed, 0 insertions, 182 deletions
diff --git a/.emacs.d/lisp/my/my-media-segment.el b/.emacs.d/lisp/my/my-media-segment.el deleted file mode 100644 index 0cef817..0000000 --- a/.emacs.d/lisp/my/my-media-segment.el +++ /dev/null @@ -1,182 +0,0 @@ -;;; 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 |