dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

mpv.el (13333B)


      1 ;;; mpv.el --- control mpv for easy note-taking  -*- lexical-binding: t; -*-
      2 
      3 ;; Copyright (C) 2014-2018  Johann Klähn
      4 
      5 ;; Author: Johann Klähn <johann@jklaehn.de>
      6 ;; URL: https://github.com/kljohann/mpv.el
      7 ;; Version: 0.2.0
      8 ;; Keywords: tools, multimedia
      9 ;; Package-Requires: ((cl-lib "0.5") (emacs "25.1") (json "1.3") (org "8.0"))
     10 
     11 ;; This program is free software; you can redistribute it and/or modify
     12 ;; it under the terms of the GNU General Public License as published by
     13 ;; the Free Software Foundation, either version 3 of the License, or
     14 ;; (at your option) any later version.
     15 
     16 ;; This program is distributed in the hope that it will be useful,
     17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     19 ;; GNU General Public License for more details.
     20 
     21 ;; You should have received a copy of the GNU General Public License
     22 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
     23 
     24 ;;; Commentary:
     25 
     26 ;; This package is a potpourri of helper functions to control a mpv
     27 ;; process via its IPC interface.  You might want to add the following
     28 ;; to your init file:
     29 ;;
     30 ;; (org-add-link-type "mpv" #'mpv-play)
     31 ;; (defun org-mpv-complete-link (&optional arg)
     32 ;;   (replace-regexp-in-string
     33 ;;    "file:" "mpv:"
     34 ;;    (org-file-complete-link arg)
     35 ;;    t t))
     36 ;; (add-hook 'org-open-at-point-functions #'mpv-seek-to-position-at-point)
     37 
     38 ;;; Code:
     39 
     40 (require 'cl-lib)
     41 (require 'json)
     42 (require 'org)
     43 (require 'org-timer)
     44 (require 'tq)
     45 
     46 (defgroup mpv nil
     47   "Customization group for mpv."
     48   :prefix "mpv-"
     49   :group 'external)
     50 
     51 (defcustom mpv-executable "mpv"
     52   "Name or path to the mpv executable."
     53   :type 'file
     54   :group 'mpv)
     55 
     56 (defcustom mpv-default-options nil
     57   "List of default options to be passed to mpv."
     58   :type '(repeat string)
     59   :group 'mpv)
     60 
     61 (defcustom mpv-speed-step 1.10
     62   "Scale factor used when adjusting playback speed."
     63   :type 'number
     64   :group 'mpv)
     65 
     66 (defcustom mpv-volume-step 1.50
     67   "Scale factor used when adjusting volume."
     68   :type 'number
     69   :group 'mpv)
     70 
     71 (defcustom mpv-seek-step 5
     72   "Step size in seconds used when seeking."
     73   :type 'number
     74   :group 'mpv)
     75 
     76 (defcustom mpv-on-event-hook nil
     77   "Hook to run when an event message is received.
     78 The hook will be called with the parsed JSON message as its only an
     79 argument.  See \"List of events\" in the mpv man page."
     80   :type 'hook
     81   :group 'mpv)
     82 
     83 (defcustom mpv-on-start-hook nil
     84   "Hook to run when a new mpv process is started.
     85 The hook will be called with the arguments passed to `mpv-start'."
     86   :type 'hook
     87   :group 'mpv)
     88 
     89 (defcustom mpv-on-exit-hook nil
     90   "Hook to run when the mpv process dies."
     91   :type 'hook
     92   :group 'mpv)
     93 
     94 (defvar mpv--process nil)
     95 (defvar mpv--queue nil)
     96 
     97 (defun mpv-live-p ()
     98   "Return non-nil if inferior mpv is running."
     99   (and mpv--process (eq (process-status mpv--process) 'run)))
    100 
    101 (defun mpv-start (&rest args)
    102   "Start an mpv process with the specified ARGS.
    103 
    104 If there already is an mpv process controlled by this Emacs instance,
    105 it will be killed.  Options specified in `mpv-default-options' will be
    106 prepended to ARGS."
    107   (mpv-kill)
    108   (let ((socket (make-temp-name
    109                  (expand-file-name "mpv-" temporary-file-directory))))
    110     (setq mpv--process
    111           (apply #'start-process "mpv-player" nil mpv-executable
    112                  "--no-terminal"
    113                  (concat "--input-unix-socket=" socket)
    114                  (append mpv-default-options args)))
    115     (set-process-query-on-exit-flag mpv--process nil)
    116     (set-process-sentinel
    117      mpv--process
    118      (lambda (process _event)
    119        (when (memq (process-status process) '(exit signal))
    120          (mpv-kill)
    121          (when (file-exists-p socket)
    122            (with-demoted-errors (delete-file socket)))
    123          (run-hooks 'mpv-on-exit-hook))))
    124     (with-timeout
    125         (0.5 (mpv-kill)
    126              (error "Failed to connect to mpv"))
    127       (while (not (file-exists-p socket))
    128         (sleep-for 0.05)))
    129     (setq mpv--queue (tq-create
    130                   (make-network-process :name "mpv-socket"
    131                                         :family 'local
    132                                         :service socket)))
    133     (set-process-filter
    134      (tq-process mpv--queue)
    135      (lambda (_proc string)
    136        (mpv--tq-filter mpv--queue string)))
    137     (run-hook-with-args 'mpv-on-start-hook args)
    138     t))
    139 
    140 (defun mpv--as-strings (command)
    141   "Convert COMMAND to a list of strings."
    142   (mapcar (lambda (arg)
    143             (if (numberp arg)
    144                 (number-to-string arg)
    145               arg))
    146           command))
    147 
    148 (defun mpv--enqueue (command fn &optional delay-command)
    149   "Add COMMAND to the transaction queue.
    150 
    151 FN will be called with the corresponding answer.
    152 If DELAY-COMMAND is non-nil, delay sending this question until
    153 the process has finished replying to any previous questions.
    154 This produces more reliable results with some processes.
    155 
    156 Note that we do not use the regexp and closure arguments of
    157 `tq-enqueue', see our custom implementation of `tq-process-buffer'
    158 below."
    159   (when (mpv-live-p)
    160     (tq-enqueue
    161      mpv--queue
    162      (concat (json-encode `((command . ,(mpv--as-strings command)))) "\n")
    163      "" nil fn delay-command)
    164     t))
    165 
    166 (defun mpv-run-command (command &rest arguments)
    167   "Send a COMMAND to mpv, passing the remaining ARGUMENTS.
    168 Block while waiting for the response."
    169   (when (mpv-live-p)
    170     (let* ((response
    171             (cl-block mpv-run-command-wait-for-response
    172               (mpv--enqueue
    173                (cons command arguments)
    174                (lambda (response)
    175                  (cl-return-from mpv-run-command-wait-for-response
    176                    response)))
    177               (while (mpv-live-p)
    178                 (sleep-for 0.05))))
    179            (status (alist-get 'error response))
    180            (data (alist-get 'data response)))
    181     (unless (string-equal status "success")
    182       (error "`%s' failed: %s" command status))
    183     data)))
    184 
    185 (defun mpv--tq-filter (tq string)
    186   "Append to the queue's buffer and process the new data.
    187 
    188 TQ is a transaction queue created by `tq-create'.
    189 STRING is the data fragment received from the process.
    190 
    191 This is a verbatim copy of `tq-filter' that uses
    192 `mpv--tq-process-buffer' instead of `tq-process-buffer'."
    193   (let ((buffer (tq-buffer tq)))
    194     (when (buffer-live-p buffer)
    195       (with-current-buffer buffer
    196         (goto-char (point-max))
    197         (insert string)
    198         (mpv--tq-process-buffer tq)))))
    199 
    200 (defun mpv--tq-process-buffer (tq)
    201   "Check TQ's buffer for a JSON response.
    202 
    203 Replacement for `tq-process-buffer' that ignores regular expressions
    204 \(answers are always passed to the first handler in the queue) and
    205 passes unsolicited event messages to `mpv-on-event-hook'."
    206   (goto-char (point-min))
    207   (skip-chars-forward "^{")
    208   (let ((answer (ignore-errors (json-read))))
    209     (when answer
    210       (delete-region (point-min) (point))
    211       ;; event messages have form {"event": ...}
    212       ;; answers have form {"error": ..., "data": ...}
    213       (cond
    214        ((assoc 'event answer)
    215         (run-hook-with-args 'mpv-on-event-hook answer))
    216        ((not (tq-queue-empty tq))
    217         (unwind-protect
    218             (funcall (tq-queue-head-fn tq) answer)
    219           (tq-queue-pop tq))))
    220       ;; Recurse to check for further JSON messages.
    221       (mpv--tq-process-buffer tq))))
    222 
    223 ;;;###autoload
    224 (defun mpv-play (path)
    225   "Start an mpv process playing the file at PATH.
    226 
    227 You can use this with `org-add-link-type' or `org-file-apps'.
    228 See `mpv-start' if you need to pass further arguments and
    229 `mpv-default-options' for default options."
    230   (interactive "fFile: ")
    231   (mpv-start (expand-file-name path)))
    232 
    233 ;;;###autoload
    234 (defun mpv-kill ()
    235   "Kill the mpv process."
    236   (interactive)
    237   (when mpv--queue
    238     (tq-close mpv--queue))
    239   (when (mpv-live-p)
    240     (kill-process mpv--process))
    241   (with-timeout
    242       (0.5 (error "Failed to kill mpv"))
    243     (while (mpv-live-p)
    244       (sleep-for 0.05)))
    245   (setq mpv--process nil)
    246   (setq mpv--queue nil))
    247 
    248 ;;;###autoload
    249 (defun mpv-pause ()
    250   "Pause or unpause playback."
    251   (interactive)
    252   (mpv--enqueue '("cycle" "pause") #'ignore))
    253 
    254 (defun mpv-get-property (property)
    255   "Return the value of the given PROPERTY."
    256   (mpv-run-command "get_property" property))
    257 
    258 (defun mpv-set-property (property value)
    259   "Set the given PROPERTY to VALUE."
    260   (mpv-run-command "set_property" property value))
    261 
    262 (defun mpv-cycle-property (property)
    263   "Cycle the given PROPERTY."
    264   (mpv-run-command "cycle" property))
    265 
    266 (defun mpv-get-playback-position ()
    267   "Return the current playback position in seconds."
    268   (mpv-get-property "playback-time"))
    269 
    270 (defun mpv-get-duration ()
    271   "Return the estimated total duration of the current file in seconds."
    272   (mpv-get-property "duration"))
    273 
    274 ;;;###autoload
    275 (defun mpv-insert-playback-position (&optional arg)
    276   "Insert the current playback position at point.
    277 
    278 When called with a non-nil ARG, insert a timer list item like `org-timer-item'."
    279   (interactive "P")
    280   (let ((time (mpv-get-playback-position)))
    281     (funcall
    282      (if arg #'mpv--position-insert-as-org-item #'insert)
    283      (org-timer-secs-to-hms (round time)))))
    284 
    285 (defun mpv--position-insert-as-org-item (time-string)
    286   "Insert a description-type item with the playback position TIME-STRING.
    287 
    288 See `org-timer-item' which this is based on."
    289   (cl-letf (((symbol-function 'org-timer)
    290              (lambda (&optional _restart no-insert)
    291                (funcall
    292                 (if no-insert #'identity #'insert)
    293                 (concat time-string " ")))))
    294     (org-timer-item)))
    295 
    296 ;;;###autoload
    297 (defun mpv-seek-to-position-at-point ()
    298   "Jump to playback position as inserted by `mpv-insert-playback-position'.
    299 
    300 This can be used with the `org-open-at-point-functions' hook."
    301   (interactive)
    302   (save-excursion
    303     (skip-chars-backward ":[:digit:]" (point-at-bol))
    304     (when (looking-at "[0-9]+:[0-9]\\{2\\}:[0-9]\\{2\\}")
    305       (let ((secs (org-timer-hms-to-secs (match-string 0))))
    306         (when (>= secs 0)
    307           (mpv-seek secs))))))
    308 
    309 ;;;###autoload
    310 (defun mpv-speed-set (factor)
    311   "Set playback speed to FACTOR."
    312   (interactive "nFactor: ")
    313   (mpv--enqueue `("set" "speed" ,(abs factor)) #'ignore))
    314 
    315 ;;;###autoload
    316 (defun mpv-speed-increase (steps)
    317   "Increase playback speed by STEPS factors of `mpv-speed-step'."
    318   (interactive "p")
    319   (let ((factor (if (>= steps 0)
    320                     (* steps mpv-speed-step)
    321                   (/ 1 (* (- steps) mpv-speed-step)))))
    322     (mpv--enqueue `("multiply" "speed" ,factor) #'ignore)))
    323 
    324 ;;;###autoload
    325 (defun mpv-speed-decrease (steps)
    326   "Decrease playback speed by STEPS factors of `mpv-speed-step'."
    327   (interactive "p")
    328   (mpv-speed-increase (- steps)))
    329 
    330 ;;;###autoload
    331 (defun mpv-volume-set (factor)
    332   "Set playback volume to FACTOR."
    333   (interactive "nFactor: ")
    334   (mpv--enqueue `("set" "volume" ,(abs factor)) #'ignore))
    335 
    336 ;;;###autoload
    337 (defun mpv-volume-increase (steps)
    338   "Increase playback volume by STEPS factors of `mpv-volume-step'."
    339   (interactive "p")
    340   (let ((factor (if (>= steps 0)
    341                     (* steps mpv-volume-step)
    342                   (/ 1 (* (- steps) mpv-volume-step)))))
    343     (mpv--enqueue `("multiply" "volume" ,factor) #'ignore)))
    344 
    345 ;;;###autoload
    346 (defun mpv-volume-decrease (steps)
    347   "Decrease playback volume by STEPS factors of `mpv-volume-step'."
    348   (interactive "p")
    349   (mpv-volume-increase (- steps)))
    350 
    351 (defun mpv--raw-prefix-to-seconds (arg)
    352   "Convert raw prefix argument ARG to seconds using `mpv-seek-step'.
    353 Numeric arguments will be treated as seconds, repeated use
    354 \\[universal-argument] will be multiplied with `mpv-seek-step'."
    355   (if (numberp arg)
    356       arg
    357     (* mpv-seek-step
    358        (cl-signum (or (car arg) 1))
    359        (log (abs (or (car arg) 4)) 4))))
    360 
    361 ;;;###autoload
    362 (defun mpv-seek (seconds)
    363   "Seek to the given (absolute) time in SECONDS.
    364 A negative value is interpreted relative to the end of the file."
    365   (interactive "nPosition in seconds: ")
    366   (mpv--enqueue `("seek" ,seconds "absolute") #'ignore))
    367 
    368 ;;;###autoload
    369 (defun mpv-seek-forward (arg)
    370   "Seek forward ARG seconds.
    371 If ARG is numeric, it is used as the number of seconds.  Else each use
    372 of \\[universal-argument] will add another `mpv-seek-step' seconds."
    373   (interactive "P")
    374   (mpv--enqueue `("seek" ,(mpv--raw-prefix-to-seconds arg) "relative") #'ignore))
    375 
    376 ;;;###autoload
    377 (defun mpv-seek-backward (arg)
    378   "Seek backward ARG seconds.
    379 If ARG is numeric, it is used as the number of seconds.  Else each use
    380 of \\[universal-argument] will add another `mpv-seek-step' seconds."
    381   (interactive "P")
    382   (mpv-seek-forward (- (mpv--raw-prefix-to-seconds arg))))
    383 
    384 ;;;###autoload
    385 (defun mpv-revert-seek ()
    386   "Undo the previous seek command."
    387   (interactive)
    388   (mpv--enqueue '("revert-seek") #'ignore))
    389 
    390 ;;;###autoload
    391 (defun mpv-playlist-next ()
    392   "Go to the next entry on the playlist."
    393   (interactive)
    394   (mpv--enqueue '("playlist-next") #'ignore))
    395 
    396 ;;;###autoload
    397 (defun mpv-playlist-prev ()
    398   "Go to the previous entry on the playlist."
    399   (interactive)
    400   (mpv--enqueue '("playlist-prev") #'ignore))
    401 
    402 ;;;###autoload
    403 (defun mpv-version ()
    404   "Return the mpv version string.
    405 When called interactively, also show a more verbose version in
    406 the echo area."
    407   (interactive)
    408   (let ((version (cadr (split-string (car (process-lines mpv-executable "--version"))))))
    409     (prog1 version
    410       (if (called-interactively-p 'interactive)
    411 	  (message "mpv %s" version)))))
    412 
    413 (provide 'mpv)
    414 ;;; mpv.el ends here