Make org-music into a package
This commit is contained in:
TEC
parent
b777aedc55
commit
e32da06758
GPG Key ID:
779591AFDB81F06C
|
|
@ -28,6 +28,9 @@
|
|||
[submodule "orgdiff"]
|
||||
path = lisp/orgdiff
|
||||
url = https://github.com/tecosaur/orgdiff.git
|
||||
[submodule "org-music"]
|
||||
path = lisp/org-music
|
||||
url = https://github.com/tecosaur/org-music.git
|
||||
[submodule "ob-julia"]
|
||||
path = lisp/ob-julia
|
||||
url = https://github.com/nico202/ob-julia.git
|
||||
|
|
|
|||
286
config.org
286
config.org
|
|
@ -5320,6 +5320,21 @@ post-processing the =latexdiff= result.
|
|||
(replace-match (format "definecolor{blue}{HTML}{%s}" blue)))))
|
||||
(add-to-list 'orgdiff-latexdiff-postprocess-hooks #'+orgdiff-nicer-change-colours))
|
||||
#+end_src
|
||||
|
||||
***** Org music
|
||||
It's nice to be able to link to music
|
||||
#+begin_src emacs-lisp
|
||||
(package! org-music :recipe (:local-repo "lisp/org-music"))
|
||||
#+end_src
|
||||
#+begin_src emacs-lisp :tangle yes
|
||||
(use-package! org-music
|
||||
:after org
|
||||
:config
|
||||
(setq org-music-mpris-player "Lollypop"
|
||||
org-music-track-search-method 'beets
|
||||
org-music-beets-db "~/Music/library.db"))
|
||||
#+end_src
|
||||
|
||||
*** Behaviour
|
||||
[[xkcd:1319]]
|
||||
**** Tweaking defaults
|
||||
|
|
@ -6604,278 +6619,7 @@ Saving seconds adds up after all! (but only so much)
|
|||
#+end_src
|
||||
|
||||
***** Music
|
||||
First, we set up all the necessarily 'utility' functions.
|
||||
#+begin_src emacs-lisp
|
||||
(after! org
|
||||
(defvar org-music-player 'mpris
|
||||
"Music player type. Curretly only supports mpris.")
|
||||
(defvar org-music-mpris-player "Lollypop"
|
||||
"Name of the mpris player, used in the form org.gnome.MPRIS.")
|
||||
(defvar org-music-track-search-method 'beets
|
||||
"Method to find the track file from the link.")
|
||||
(defvar org-music-beets-db "~/Music/library.db"
|
||||
"Location of the beets DB, for when using beets as the `org-music-track-search-method'")
|
||||
(defvar org-music-folder "~/Music/"
|
||||
"Location of your music folder, for when using file as the `org-music-track-search-method'")
|
||||
(defvar org-music-recognised-extensions '("flac" "mp4" "m4a" "aiff" "wav" "ogg" "aiff")
|
||||
"When searching for files in `org-music-track-search-method', recognise these extensions as audio files.")
|
||||
|
||||
(defun org-music-get-link (full &optional include-time)
|
||||
"Generate link string for currently playing track, optionally including a time-stamp"
|
||||
(pcase org-music-player ;; NOTE this could do with better generalisation
|
||||
('mpris (let* ((track-metadata
|
||||
(org-music-mpris-get-property "Metadata"))
|
||||
(album-artist (caar (cadr (assoc "xesam:albumArtist" track-metadata))))
|
||||
(artist (if (or (equal album-artist "")
|
||||
(s-contains-p "various" album-artist t))
|
||||
(caar (cadr (assoc "xesam:artist" track-metadata)))
|
||||
album-artist))
|
||||
(track (car (cadr (assoc "xesam:title" track-metadata))))
|
||||
(start-time (when include-time
|
||||
(/ (org-music-mpris-get-property "Position") 1000000))))
|
||||
(if full
|
||||
(format "[[music:%s][%s by %s]]" (org-music-format-link artist track start-time) track artist)
|
||||
(org-music-format-link artist track start-time))))
|
||||
(_ (user-error! "The specified music player: %s is not supported" org-music-player))))
|
||||
|
||||
(defun org-music-format-link (artist track &optional start-time end-time)
|
||||
(let ((artist (replace-regexp-in-string ":" "\\:" artist))
|
||||
(track (replace-regexp-in-string ":" "\\:" track)))
|
||||
(concat artist ":" track
|
||||
(cond ((and start-time end-time)
|
||||
(format "::%s-%s"
|
||||
(org-music-seconds-to-time start-time)
|
||||
(org-music-seconds-to-time end-time)))
|
||||
(start-time
|
||||
(format "::%s"
|
||||
(org-music-seconds-to-time start-time)))))))
|
||||
|
||||
(defun org-music-parse-link (link)
|
||||
(let* ((link-dc (->> link
|
||||
(replace-regexp-in-string "\\([^\\\\]\\)\\\\:" "\\1#COLON#")
|
||||
(replace-regexp-in-string "\\(::[a-z0-9]*[0-9]\\)\\'" "\\1s")))
|
||||
(link-components (mapcar (lambda (lc) (replace-regexp-in-string "#COLON#" ":" lc))
|
||||
(s-split ":" link-dc)))
|
||||
(artist (nth 0 link-components))
|
||||
(track (nth 1 link-components))
|
||||
(durations (when (and (> (length link-components) 3)
|
||||
(equal (nth 2 link-components) ""))
|
||||
(s-split "-" (nth 3 link-components))))
|
||||
(start-time (when durations
|
||||
(org-music-time-to-seconds (car durations))))
|
||||
(end-time (when (cdr durations)
|
||||
(org-music-time-to-seconds (cadr durations)))))
|
||||
(list artist track start-time end-time)))
|
||||
|
||||
(defun org-music-seconds-to-time (seconds)
|
||||
"Convert a number of seconds to a nice human duration, e.g. 5m21s.
|
||||
This action is reversed by `org-music-time-to-seconds'."
|
||||
(if (< seconds 60)
|
||||
(format "%ss" seconds)
|
||||
(if (< seconds 3600)
|
||||
(format "%sm%ss" (/ seconds 60) (% seconds 60))
|
||||
(format "%sh%sm%ss" (/ seconds 3600) (/ (% seconds 3600) 60) (% seconds 60)))))
|
||||
|
||||
(defun org-music-time-to-seconds (time-str)
|
||||
"Get the number of seconds in a string produced by `org-music-seconds-to-time'."
|
||||
(let* ((time-components (reverse (s-split "[a-z]" time-str)))
|
||||
(seconds (string-to-number (nth 1 time-components)))
|
||||
(minutes (when (> (length time-components) 2)
|
||||
(string-to-number (nth 2 time-components))))
|
||||
(hours (when (> (length time-components) 3)
|
||||
(string-to-number (nth 3 time-components)))))
|
||||
(+ (* 3600 (or hours 0)) (* 60 (or minutes 0)) seconds)))
|
||||
|
||||
(defun org-music-play-track (artist title &optional start-time end-time)
|
||||
"Play the track specified by ARTIST and TITLE, optionally skipping to START-TIME in, stopping at END-TIME."
|
||||
(if-let ((file (org-music-find-track-file artist title)))
|
||||
(pcase org-music-player
|
||||
('mpris (org-music-mpris-play file start-time end-time))
|
||||
(_ (user-error! "The specified music player: %s is not supported" org-music-player)))
|
||||
(user-error! "Could not find the track '%s' by '%s'" title artist)))
|
||||
|
||||
(add-transient-hook! #'org-music-play-track
|
||||
(require 'dbus))
|
||||
|
||||
(defun org-music-mpris-play (file &optional start-time end-time)
|
||||
(let ((uri (url-encode-url (rng-file-name-uri file))))
|
||||
(org-music-mpris-call-method "OpenUri" uri)
|
||||
(let ((track-id (caadr (assoc "mpris:trackid"
|
||||
(org-music-mpris-get-property "Metadata")))))
|
||||
(when start-time
|
||||
(org-music-mpris-call-method "SetPosition" :object-path track-id
|
||||
:int64 (round (* start-time 1000000))))
|
||||
(when end-time
|
||||
(org-music-mpris-stop-at-time uri end-time)))))
|
||||
|
||||
(defun orgb3-music-mpris-stop-at-time (url end-time)
|
||||
"Check that url is playing, and if it is stop it at END-TIME."
|
||||
(when (equal url (caadr (assoc "xesam:url" (org-music-mpris-get-property "Metadata"))))
|
||||
(let* ((time-current (/ (/ (org-music-mpris-get-property "Position") 10000) 100.0))
|
||||
(time-delta (- end-time time-current)))
|
||||
(message "%s" time-delta)
|
||||
(if (< time-delta 0)
|
||||
(org-music-mpris-call-method "Pause")
|
||||
(if (< time-delta 6)
|
||||
(run-at-time (max 0.001 (* 0.9 time-delta)) nil #'org-music-mpris-stop-at-time url end-time)
|
||||
(run-at-time 5 nil #'org-music-mpris-stop-at-time url end-time))))))
|
||||
|
||||
(defun org-music-mpris-get-property (property)
|
||||
"Return the value of org.mpris.MediaPlayer2.Player.PROPERTY."
|
||||
(dbus-get-property :session (concat "org.gnome." org-music-mpris-player)
|
||||
"/org/mpris/MediaPlayer2" "org.mpris.MediaPlayer2.Player"
|
||||
property))
|
||||
|
||||
(defun org-music-mpris-call-method (property &rest args)
|
||||
"Call org.mpris.MediaPlayer2.Player.PROPERTY with ARGS, returning the result."
|
||||
(apply #'dbus-call-method :session (concat "org.gnome." org-music-mpris-player)
|
||||
"/org/mpris/MediaPlayer2" "org.mpris.MediaPlayer2.Player"
|
||||
property args))
|
||||
|
||||
(defun org-music-guess-mpris-player ()
|
||||
(when-let ((players
|
||||
(-filter (lambda (interface)
|
||||
(s-contains-p "org.mpris.MediaPlayer2" interface))
|
||||
(dbus-call-method :session
|
||||
dbus-service-dbus
|
||||
dbus-path-dbus
|
||||
dbus-interface-dbus
|
||||
"ListNames"))))
|
||||
(replace-regexp-in-string "org\\.mpris\\.MediaPlayer2\\." "" (car players))))
|
||||
|
||||
(when (eq org-music-player 'mpris)
|
||||
(unless org-music-mpris-player
|
||||
(setq org-music-mpris-player (org-music-guess-mpris-player))))
|
||||
|
||||
(defun org-music-find-track-file (artist title)
|
||||
"Try to find the file for TRACK by ARTIST, using `org-music-track-search-method', returning nil if nothing could be found."
|
||||
(pcase org-music-track-search-method
|
||||
('file (org-music-find-file artist title))
|
||||
('beets (org-music-beets-find-file artist title))
|
||||
(_ (user-error! "The specified music search method: %s is not supported" org-music-track-search-method))))
|
||||
|
||||
(defun org-music-beets-find-file (artist title)
|
||||
"Find the file correspanding to a given artist and title."
|
||||
(let* ((artist-escaped (replace-regexp-in-string "\"" "\\\"" artist))
|
||||
(title-escaped (replace-regexp-in-string "\"" "\\\"" title))
|
||||
(file
|
||||
(or
|
||||
(shell-command-to-string
|
||||
(format
|
||||
"sqlite3 '%s' \"SELECT path FROM items WHERE albumartist IS '%s' AND title IS '%s' LIMIT 1 COLLATE NOCASE\""
|
||||
(expand-file-name org-music-beets-db) artist-escaped title-escaped))
|
||||
(shell-command-to-string
|
||||
(format
|
||||
"sqlite3 '%s' \"SELECT path FROM items WHERE artist IS '%s' AND title IS '%s' LIMIT 1 COLLATE NOCASE\""
|
||||
(expand-file-name org-music-beets-db) artist-escaped title-escaped)))))
|
||||
(if (> (length file) 0)
|
||||
(substring file 0 -1)
|
||||
)))
|
||||
|
||||
(defun org-music-find-file (artist title)
|
||||
"Try to find a file in `org-music-folder' which contains TITLE, looking first in ./ARTIST if possible."
|
||||
(when-let* ((music-folder (expand-file-name org-music-folder))
|
||||
(search-folders (or
|
||||
(-filter ; look for folders which contain ARTIST
|
||||
(lambda (file-or-folder)
|
||||
(and
|
||||
(s-contains-p artist (file-name-base file-or-folder) t)
|
||||
(file-directory-p file-or-folder)))
|
||||
(directory-files music-folder t))
|
||||
(list music-folder)))
|
||||
(extension-regex (format "\\.\\(?:%s\\)\\'" (s-join "\\|" org-music-recognised-extensions)))
|
||||
(tracks (-filter
|
||||
(lambda (file)
|
||||
(s-contains-p title (file-name-base file) t))
|
||||
(-flatten (mapcar (lambda (dir)
|
||||
(directory-files-recursively dir extension-regex))
|
||||
search-folders)))))
|
||||
(when (> (length tracks) 1)
|
||||
(message "Warning: multiple matches for %s by %s found" title artist))
|
||||
(car tracks))))
|
||||
#+end_src
|
||||
|
||||
Then we integrate this nicely with org-mode
|
||||
#+begin_src emacs-lisp
|
||||
(after! org
|
||||
(org-link-set-parameters "music"
|
||||
:follow #'org-music-open-fn
|
||||
:export #'org-music-export-text)
|
||||
|
||||
(org-link-set-parameters "Music" ;; like music, but visually fancier
|
||||
;; FIXME this should work as far as I can tell
|
||||
;; :image-data-fun #'org-music-image-fn
|
||||
:follow #'org-music-open-fn
|
||||
:export #'org-music-fancy-export)
|
||||
|
||||
(defun org-music-open-fn (link)
|
||||
(apply #'org-music-play-track (org-music-parse-link link)))
|
||||
|
||||
(defun org-music-insert-current-track (&optional include-time)
|
||||
"Insert link to currest track, including a timestamp when the universal argument is supplied."
|
||||
(interactive "P")
|
||||
(pp include-time)
|
||||
(insert (org-music-get-link t include-time)))
|
||||
|
||||
(defun org-music-export-text (path desc backend _com &optional newline)
|
||||
(let* ((track-info (org-music-parse-link path))
|
||||
(artist (nth 0 track-info))
|
||||
(track (nth 1 track-info))
|
||||
(start-time (nth 2 track-info))
|
||||
(end-time (nth 3 track-info))
|
||||
(emphasise (cond ((org-export-derived-backend-p backend 'html)
|
||||
(lambda (s) (format "<span style=\"font-style: italic\">%s</span>" s)))
|
||||
((org-export-derived-backend-p backend 'latex)
|
||||
(lambda (s) (format "\\emph{%s}" s)))
|
||||
(t (lambda (s) s)))))
|
||||
(or desc
|
||||
(concat
|
||||
(cond ((and start-time end-time)
|
||||
(format "%s to %s seconds of%s" start-time end-time (or newline " ")))
|
||||
(start-time
|
||||
(format "%s seconds into%s" start-time (or newline " "))))
|
||||
(funcall emphasise track)
|
||||
(or newline " ")
|
||||
"by "
|
||||
artist))))
|
||||
|
||||
(defun org-music-cover-image (track-file)
|
||||
"Try to find a cover image for the track in the given location"
|
||||
(car (-filter (lambda (file)
|
||||
(-contains-p '("png" "jpg" "jpeg") (file-name-extension file)))
|
||||
(directory-files (file-name-directory track-file) t "cover"))))
|
||||
|
||||
(defun org-music-image-fn (_protocol link _description)
|
||||
(when-let* ((track-data (org-music-parse-link link))
|
||||
(cover-file (org-music-cover-image
|
||||
(org-music-find-track-file
|
||||
(nth 0 track-data) (nth 1 track-data)))))
|
||||
(with-temp-buffer
|
||||
(set-buffer-multibyte nil)
|
||||
(setq buffer-file-coding-system 'binary)
|
||||
(insert-file-contents-literally cover-file)
|
||||
(buffer-substring-no-properties (point-min) (point-max)))))
|
||||
|
||||
(defun org-music-fancy-export (path desc backend _com)
|
||||
(let* ((track-data (org-music-parse-link path))
|
||||
(file (org-music-find-track-file
|
||||
(nth 0 track-data) (nth 1 track-data)))
|
||||
(cover-img (org-music-cover-image file))
|
||||
(newline-str (cond ((org-export-derived-backend-p backend 'html) "<br>")
|
||||
((org-export-derived-backend-p backend 'latex) "\\newline ")
|
||||
(t " ")))
|
||||
(text (org-music-export-text path nil backend nil newline-str)))
|
||||
(cond ((org-export-derived-backend-p backend 'html)
|
||||
(format "<div class='music-track'>
|
||||
<img src='%s'> <span>%s</span>
|
||||
</div>" cover-img text)
|
||||
)
|
||||
((org-export-derived-backend-p backend 'latex)
|
||||
(format "\\begin{tabular}{@{\\hspace{0.3\\columnwidth}}r@{\\hspace{0.1\\columnwidth}}p{0.4\\columnwidth}}
|
||||
\\includegraphics[height=6em]{%s} & \\vspace{-0.12\\columnwidth}%s
|
||||
\\end{tabular}" cover-img text))
|
||||
(t text)))))
|
||||
#+end_src
|
||||
***** YouTube
|
||||
The ~[[yt:...]]~ links preview nicely, but don't export nicely. Thankfully, we can
|
||||
fix that.
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Subproject commit fa0c84ee7c0991593d574fc662f55170abd6a3f5
|
||||
Loading…
Reference in New Issue