08df9f5a9988aa8594810cfb53675fd2aa29b481
[emus.git] / emus.el
1 ;;; emus.el --- Simple mp3 player  -*- lexical-binding:t -*-
2
3 ;; Copyright (C) 2019 Tim Vaughan
4
5 ;; Author: Tim Vaughan <timv@ughan.xyz>
6 ;; Created: 8 December 2019
7 ;; Version: 1.0
8 ;; Keywords: multimedia
9 ;; Homepage: http://thelambdalab.xy/emus
10 ;; Package-Requires: ((emacs "26"))
11
12 ;; This file is not part of GNU Emacs.
13
14 ;; This program is free software: you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation, either version 3 of the License, or
17 ;; (at your option) any later version.
18
19 ;; This program is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
22 ;; GNU General Public License for more details.
23
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with this file.  If not, see <http://www.gnu.org/licenses/>.
26
27 ;;; Commentary:
28
29 ;; This is a simple package for playing audio from a local directory
30 ;; tree of mp3 files.  It uses the program mpg123 as its back-end.
31 ;; Currently the library is loaded completely every time emus starts.
32
33 ;;; Code:
34
35 (provide 'emus)
36
37
38 ;;; Dependencies
39 ;;
40
41 (require 'seq)
42
43
44 ;;; Customizations
45 ;;
46
47 (defgroup emus nil
48   "Simple music player for Emacs."
49   :group 'multimedia)
50
51 (defcustom emus-directory "~/Music/"
52   "Directory containing audio files for emus."
53   :type '(string))
54
55 (defcustom emus-mpg123-program "mpg123"
56   "Name of (and, optionally, path to) mpg123 binary."
57   :type '(string))
58
59 (defface emus-artist
60   '((((background dark)) :inherit font-lock-string-face :background "#222" :extend t)
61     (t :inherit font-lock-string-face :background "#ddd" :extend t))
62   "Face used for artist names in browser.")
63
64 (defface emus-album
65   '((((background dark)) :inherit font-lock-constant-face :background "#111" :extend t)
66     (t :inherit font-lock-constant-face :background "#eee" :extend t))
67   "Face used for album names in browser.")
68
69 (defface emus-track
70   '((t :inherit font-lock-keyword-face))
71   "Face used for track titles in browser.")
72
73 (defface emus-track-current
74   '((t :inherit font-lock-keyword-face :inverse-video t :extend t))
75   "Face used for track titles in browser.")
76
77 (defface emus-cursor
78   '((t :inherit bold))
79   "Face used for current track cursor")
80
81
82 ;;; Global variables
83
84 (defvar emus--proc-in-use nil
85   "If non-nil, disables `emus-send-cmd'.
86 Used to prevent commands from interfering with library construction.")
87
88 (defvar emus-tracks nil
89   "Emus audio library.")
90
91 (defvar emus-current-track nil
92   "Currently-selected emus track.")
93
94 (defvar emus-state 'stopped
95   "Current playback state.")
96
97 (defvar emus-continuous-playback t
98   "If non-nil, emus will automatically play the next track when the current track is finished.")
99
100 (defvar emus-current-volume 100
101   "The current playback volume.")
102
103
104 ;;; mpg123 process
105 ;;
106
107
108 (defun emus-get-process ()
109   "Return current or new mpg123 process."
110   (let* ((emus-process-raw (get-process "emus-process"))
111          (emus-process (if emus-process-raw
112                            (if (process-live-p emus-process-raw)
113                                emus-process-raw
114                              (kill-process emus-process-raw)
115                              nil))))
116     (if emus-process
117         emus-process
118       (let ((proc
119              (make-process :name "emus-process"
120                            :command `(,emus-mpg123-program "-R"))))
121         (set-process-query-on-exit-flag proc nil)
122         (process-send-string proc "silence\n")
123         proc))))
124
125 (defun emus--send-cmd-raw (cmd &rest args)
126   "Send a command CMD with args ARGS to the mpg123 process.
127 This procedure does not respect `emus--proc-in-use' and thus should only
128 be used by `emus--load-library'."
129     (process-send-string (emus-get-process)
130                          (concat
131                           (seq-reduce (lambda (s1 s2) (concat s1 " " s2)) args cmd)
132                           "\n")))
133
134 (defun emus-send-cmd (cmd &rest args)
135   "Send a command CMD with args ARGS to the mpg123 process."
136   (unless emus--proc-in-use
137     (apply #'emus--send-cmd-raw cmd args)))
138
139
140 ;;; Library
141 ;;
142
143 (defun emus-get-audio-files ()
144   "Get all mp3 files in main emus directory."
145   (mapcar
146    #'expand-file-name
147    (directory-files-recursively emus-directory ".*\\.mp3")))
148
149 (defun emus-get-playlist-files ()
150   "Get all m3u files in the main emus music directory."
151   (mapcar
152    #'expand-file-name
153    (directory-files-recursively emus-directory ".*\\.m3u")))
154
155 (defun emus-make-track (artist album title filename &optional pos)
156   "Create an object representing an emus track.
157 ARTIST, ALBUM and TITLE are used to describe the track, FILENAME
158 refers to the mp3 file containing the track.  If non-nil, POS
159 specifies the position of the record representing this track in the
160 emus browser buffer."
161   (list artist album title filename pos))
162
163 (defun emus-track-artist (track)
164   "The artist corresponding to TRACK."
165   (elt track 0))
166
167 (defun emus-track-album (track)
168   "The album corresponding to TRACK."
169   (elt track 1))
170
171 (defun emus-track-title (track)
172   "The title of TRACK."
173   (elt track 2))
174
175 (defun emus-track-file (track)
176   "The mp3 file corresponding to TRACK."
177   (elt track 3))
178
179 (defun emus-track-browser-pos (track)
180   "The location of the browser buffer record corresponding to TRACK."
181   (elt track 4))
182
183 (defun emus-set-track-browser-pos (track pos)
184   "Set the location of the browser buffer record corresponding to TRACK to POS."
185   (setf (seq-elt track 4) pos))
186
187 (defun emus--load-library (then)
188   "Initialize the emus track library.
189 Once the library is initialized, the function THEN is called."
190   (unless emus--proc-in-use
191     (setq emus--proc-in-use t)
192     (emus--suspend-cp)
193     (setq emus-state 'stopped)
194     (setq emus-tracks (emus--make-tracks-from-playlist-files (emus-get-playlist-files)))
195     (let ((proc (emus-get-process))
196           (tagstr "")
197           (filenames (emus-get-audio-files)))
198       (set-process-filter proc (lambda (proc string)
199                                  (setq tagstr (concat tagstr string))
200                                  (when (string-suffix-p "@P 1\n" string)
201                                    (add-to-list 'emus-tracks
202                                                 (emus--make-track-from-tagstr (car filenames)
203                                                                               tagstr))
204                                    (setq tagstr "")
205                                    (setq filenames (cdr filenames))
206                                    (if filenames
207                                        (emus--send-cmd-raw "lp" (car filenames))
208                                      (set-process-filter proc nil)
209                                      (setq emus-tracks (reverse emus-tracks))
210                                      (emus--sort-tracks)
211                                      (unless emus-current-track
212                                        (setq emus-current-track (car emus-tracks)))
213                                      (funcall then)
214                                      (emus--resume-cp)
215                                      (setq emus--proc-in-use nil)))))
216       (emus--send-cmd-raw "lp" (car filenames)))))
217
218 (defun emus--dump-tracks ()
219     emus-tracks)
220
221 (defun emus--make-track-from-tagstr (filename tagstr)
222   "Parse TAGSTR to populate the fields of a track corresponding to FILENAME."
223   (let ((artist "")
224         (album "")
225         (title ""))
226     (dolist (line (split-string tagstr "\n"))
227       (let ((found-artist (elt (split-string line "@I ID3v2.artist:") 1))
228             (found-album (elt (split-string line "@I ID3v2.album:") 1))
229             (found-title (elt (split-string line "@I ID3v2.title:") 1)))
230         (cond
231          (found-artist (setq artist found-artist))
232          (found-album (setq album found-album))
233          (found-title (setq title found-title)))))
234     (emus-make-track artist album title filename)))
235
236 (defun emus--make-tracks-from-playlist-files (filenames)
237   (let ((tracks nil))
238     (dolist (filename filenames)
239       (let ((artist "Playlists")
240             (album (file-name-base filename))
241             (title nil)
242             (lines (split-string (with-temp-buffer
243                                    (insert-file-contents filename)
244                                    (buffer-string))
245                                  "\n")))
246         (dolist (line lines)
247           (pcase (string-trim line)
248             ((rx (: string-start
249                     (* space)
250                     "#extinf:"
251                     (* (not ",")) ","
252                     (let display-title (* any))
253                     string-end))
254              (setq title display-title))
255             ((rx (: string-start (* space) "#"))) ;skip other comments
256             ((rx (let filename (+ any)))
257              (setq tracks (cons (emus-make-track artist album (or title filename) filename)
258                                 tracks))
259              (setq title nil))))))
260     tracks))
261
262 (defun emus--sort-tracks ()
263   "Sort the library tracks according to artist and album.
264 Leaves the track titles unsorted, so they will appear in the order specified
265 by the filesystem."
266   (setq emus-tracks
267         (sort emus-tracks
268               (lambda (r1 r2)
269                 (let ((artist1 (emus-track-artist r1))
270                       (artist2 (emus-track-artist r2)))
271                   (if (string= artist1 artist2)
272                       (let ((album1 (emus-track-album r1))
273                             (album2 (emus-track-album r2)))
274                         (string< album1 album2))
275                     (if (equal artist1 "Playlists")
276                         t
277                       (if (equal artist2 "Playlists")
278                           nil
279                         (string< artist1 artist2)))))))))
280
281 (defmacro emus--with-library (&rest body)
282   "Evaluate BODY with the library initialized."
283   `(if emus-tracks
284        (unless emus--proc-in-use ,@body)
285      (emus--load-library
286       (lambda () ,@body))))
287
288
289 ;;; Playback
290 ;;
291
292 (defun emus--suspend-cp ()
293   "Suspend continuous playback."
294   (setq emus-continuous-playback nil))
295
296 (defun emus--resume-cp ()
297   "Resume continuous playback."
298   (setq emus-continuous-playback t)
299   (set-process-filter (emus-get-process)
300                       (lambda (_proc string)
301                         (and emus-continuous-playback
302                              (eq emus-state 'playing)
303                              (string-suffix-p "@P 0\n" string)
304                              (emus-play-next)))))
305
306 (defun emus-play-track (track)
307   "Set TRACK as current and start playing."
308   (emus--with-library
309    (let ((old-track emus-current-track))
310      (emus-send-cmd "l" (emus-track-file track))
311      (setq emus-state 'playing)
312      (setq emus-current-track track)
313      (emus--update-track old-track)
314      (emus--update-track track)
315      (emus--resume-cp)
316      (emus-goto-current))))
317
318 (defun emus-select-track (track)
319   "Set TRACK as current, but do not start playing."
320   (emus--with-library
321    (let ((old-track emus-current-track))
322      (setq emus-state 'stopped)
323      (setq emus-current-track track)
324      (emus--update-track old-track)
325      (emus--update-track track)
326      (emus-send-cmd "o")
327      (emus--resume-cp)
328      (emus-goto-current))))
329
330 (defun emus-stop ()
331   "Stop playback of the current track."
332   (interactive)
333   (emus--with-library
334    (setq emus-state 'stopped)
335    (emus--update-track emus-current-track)
336    (emus-send-cmd "s")))
337
338 (defun emus-playpause ()
339   "Begin playback of the current track.
340 If the track is already playing, pause playback.
341 If the track is currently paused, resume playback."
342   (interactive)
343   (emus--with-library
344    (when emus-current-track
345      (if (eq emus-state 'stopped)
346          (emus-play-track emus-current-track)
347        (emus-send-cmd "p")
348        (pcase emus-state
349          ((or 'paused 'stopped) (setq emus-state 'playing))
350          ('playing (setq emus-state 'paused)))
351        (unless (eq emus-state 'paused)))
352      (emus--update-track emus-current-track))))
353
354 (defun emus-set-volume (pct)
355   "Set the playback volume to PCT %."
356   (emus--with-library
357    (setq emus-current-volume pct)
358    (emus-send-cmd "v" (number-to-string pct))))
359
360 (defun emus-volume-increase-by (delta)
361   "Increase the playback volume by DELTA %."
362   (emus-set-volume (max 0 (min 100 (+ emus-current-volume delta)))))
363
364 (defun emus-volume-up ()
365   "Increase the playback volume by 10%."
366   (interactive)
367   (emus-volume-increase-by 10))
368
369 (defun emus-volume-down ()
370   "Decrease the playback volume by 10%."
371   (interactive)
372   (emus-volume-increase-by -10))
373
374 (defun emus--play-adjacent-track (&optional prev)
375   "Play the next track in the library, or the previous if PREV is non-nil."
376   (emus--with-library
377    (let ((idx (seq-position emus-tracks emus-current-track))
378          (offset (if prev -1 +1)))
379      (if idx
380          (let ((next-track (elt emus-tracks (+ idx offset))))
381            (if next-track
382                (if (eq emus-state 'playing)
383                    (emus-play-track next-track)
384                  (emus-select-track next-track))
385              (error "Track does not exist")))
386        (error "No track selected")))))
387
388 (defun emus--play-adjacent-album (&optional prev)
389   "Play the first track of the next album in the library.
390 If PREV is non-nil, plays the last track of the previous album."
391   (emus--with-library
392    (let ((idx (seq-position emus-tracks emus-current-track)))
393      (if idx
394          (let* ((search-list (if prev
395                                  (reverse (seq-subseq emus-tracks 0 idx))
396                                (seq-subseq emus-tracks (+ idx 1))))
397                 (current-album (emus-track-album emus-current-track))
398                 (next-track (seq-some (lambda (r)
399                                         (if (string= (emus-track-album r)
400                                                      current-album)
401                                             nil
402                                           r))
403                                       search-list)))
404            (if next-track
405                (if (eq emus-state 'playing)
406                    (emus-play-track next-track)
407                  (emus-select-track next-track))
408              (error "Track does not exist")))
409        (error "No track selected")))))
410
411 (defun emus-play-next ()
412   "Play the next track in the library."
413   (interactive)
414   (emus--play-adjacent-track))
415
416 (defun emus-play-prev ()
417   "Play the previous track in the library."
418   (interactive)
419   (emus--play-adjacent-track t))
420
421 (defun emus-play-next-album ()
422   "Play the first track of the next album in the library."
423   (interactive)
424   (emus--play-adjacent-album))
425
426 (defun emus-play-prev-album ()
427   "Play the last track of the previous album in the library."
428   (interactive)
429   (emus--play-adjacent-album t))
430
431 (defun emus-jump (seconds)
432   "Jump forward in current track by SECONDS seconds."
433   (emus--with-library
434    (emus-send-cmd "jump" (format "%+ds" seconds))))
435
436 (defun emus-jump-10s-forward ()
437   "Jump 10 seconds forward in current track."
438   (interactive)
439   (emus-jump 10))
440
441 (defun emus-jump-10s-backward ()
442   "Jump 10 seconds backward in current track."
443   (interactive)
444   (emus-jump -10))
445
446 (defun emus-display-status ()
447   "Display the current playback status in the minibuffer."
448   (interactive)
449   (emus--with-library
450    (message
451     (concat "Emus: Volume %d%%"
452             (pcase emus-state
453               ('stopped " [Stopped]")
454               ('paused " [Paused]")
455               ('playing " [Playing]")
456               (_ ""))
457             " %s")
458     emus-current-volume
459     (if emus-current-track
460         (format "- %.30s (%.20s)"
461                 (emus-track-title emus-current-track)
462                 (emus-track-artist emus-current-track))
463       ""))))
464
465
466 ;;; Browser
467 ;;
468
469 (defun emus--insert-track (track &optional prev-track first)
470   "Insert a button representing TRACK into the current buffer.
471
472 When provided, PREV-TRACK is used to determine whether to insert additional
473 headers representing the artist or the album title.
474
475 If non-nil, FIRST indicates that the track is the first in the library
476 and thus requires both artist and album headers."
477   (let* ((artist (emus-track-artist track))
478          (album (emus-track-album track))
479          (title (emus-track-title track))
480          (album-symb (intern (concat artist album)))
481          (help-str (format "mouse-1, RET: Play '%.30s' (%.20s)" title artist))
482          (field (intern album))) ;Allows easy jumping between albums with cursor.
483     (when (or prev-track first)
484       (unless (equal (emus-track-artist prev-track) artist)
485         (insert-text-button
486          (propertize artist 'face 'emus-artist)
487          'action #'emus--click-track
488          'follow-link t
489          'help-echo help-str
490          'emus-track track
491          'field field)
492         (insert (propertize "\n"
493                             'face 'emus-artist
494                             'field field)))
495       (unless (equal (emus-track-album prev-track) album)
496         (insert-text-button
497          (propertize (concat "  " album) 'face 'emus-album)
498          'action #'emus--click-track
499          'follow-link t
500          'help-echo help-str
501          'emus-track track
502          'field field)
503         (insert (propertize "\n"
504                             'face 'emus-album
505                             'field field))))
506     (emus-set-track-browser-pos track (point))
507     (let ((is-current (equal track emus-current-track)))
508       (insert-text-button
509        (concat
510         (if is-current
511             (propertize
512              (pcase emus-state
513                ('playing "->")
514                ('paused "-)")
515                ('stopped "-]"))
516              'face 'emus-cursor)
517           (propertize "  " 'face 'default))
518         (propertize (format "   %s" title)
519                     'face (if is-current
520                               'emus-track-current
521                             'emus-track)))
522        'action #'emus--click-track
523        'follow-link t
524        'help-echo help-str
525        'emus-track track
526        'invisible album-symb
527        'field field)
528       (insert (propertize "\n"
529                           'face (if is-current
530                                     'emus-track-current
531                                   'emus-track)
532                           'field field
533                           'invisible album-symb)))))
534
535 (defun emus--update-track (track)
536   "Rerender entry for TRACK in emus browser buffer.
537 Used to update browser display when `emus-current-track' and/or `emus-state' changes."
538   (let ((track-pos (emus-track-browser-pos track)))
539     (when (and (get-buffer "*emus*")
540                (emus-track-browser-pos track))
541       (with-current-buffer "*emus*"
542         (let ((inhibit-read-only t)
543               (old-point (point)))
544           (goto-char track-pos)
545           (search-forward "\n")
546           (delete-region track-pos (point))
547           (goto-char track-pos)
548           (emus--insert-track track)
549           (goto-char old-point))))))
550
551 (defun emus--render-tracks ()
552   "Render all library tracks in emus browser buffer."
553   (with-current-buffer "*emus*"
554     (let ((inhibit-read-only t)
555           (old-pos (point)))
556       (erase-buffer)
557       (goto-char (point-min))
558       (let ((prev-track nil))
559         (dolist (track emus-tracks)
560           (emus--insert-track track prev-track (not prev-track))
561           (setq prev-track track)))
562       (goto-char old-pos))))
563
564 (defun emus--click-track (button)
565   "Begin playback of track indicated by BUTTON."
566   (emus-play-track (button-get button 'emus-track))
567   (emus-display-status))
568
569 (defun emus-goto-current ()
570   "Move point to the current track in the browser buffer, if available."
571   (interactive)
572   (when (and (get-buffer "*emus*")
573              emus-current-track)
574     (with-current-buffer "*emus*"
575         (goto-char (emus-track-browser-pos emus-current-track)))))
576
577 (defun emus-browse ()
578   "Switch to *emus* audio library browser."
579   (interactive)
580   (emus--with-library
581    (pop-to-buffer-same-window "*emus*")
582    (emus-browser-mode)
583    (emus--render-tracks)
584    (emus-goto-current)))
585
586 (defun emus-refresh ()
587   "Refresh the emus library."
588   (interactive)
589   (emus-stop)
590   (setq emus-tracks nil)
591   (emus-browse))
592
593
594 ;;; Playback + status display commands
595 ;;
596
597 (defun emus-playpause-status ()
598   "Start, pause or resume playback, then display the emus status in the minibuffer."
599   (interactive)
600   (emus-playpause)
601   (emus-display-status))
602
603 (defun emus-stop-status ()
604   "Stop playback, then display the emus status in the minibuffer."
605   (interactive)
606   (emus-stop)
607   (emus-display-status))
608
609 (defun emus-volume-up-status ()
610   "Increase volume by 10%, then display the emus status in the minibuffer."
611   (interactive)
612   (emus-volume-up)
613   (emus-display-status))
614
615 (defun emus-volume-down-status ()
616   "Decrease volume by 10%, then display the emus status in the minibuffer."
617   (interactive)
618   (emus-volume-down)
619   (emus-display-status))
620
621 (defun emus-play-next-status ()
622   "Play next track, then display the emus status in the minibuffer."
623   (interactive)
624   (emus-play-next)
625   (emus-display-status))
626
627 (defun emus-play-prev-status ()
628   "Play previous track, then display the emus status in the minibuffer."
629   (interactive)
630   (emus-play-prev)
631   (emus-display-status))
632
633 (defun emus-play-next-album-status ()
634   "Play first track of next album, then display the emus status in the minibuffer."
635   (interactive)
636   (emus-play-next-album)
637   (emus-display-status))
638
639 (defun emus-play-prev-album-status ()
640   "Play last track of previous album, then display the emus status in the minibuffer."
641   (interactive)
642   (emus-play-prev-album)
643   (emus-display-status))
644
645 (defun emus-jump-10s-forward-status ()
646   "Jump 10s forward in current track, then display the emus status in the minibuffer."
647   (interactive)
648   (emus-jump-10s-forward)
649   (emus-display-status))
650
651 (defun emus-jump-10s-backward-status ()
652   "Jump 10s backward in current track, then display the emus status in the minibuffer."
653   (interactive)
654   (emus-jump-10s-backward)
655   (emus-display-status))
656
657 (defun emus-goto-current-status ()
658   "Move point to the current track, then display the emus status in the minibuffer."
659   (interactive)
660   (emus-goto-current)
661   (emus-display-status))
662
663 (defun emus-refresh-status ()
664   "Refresh the emus library, then display the emus status in the minibuffer."
665   (interactive)
666   (emus-stop)
667   (setq emus-tracks nil)
668   (emus--with-library
669    (emus-browse)
670    (emus-display-status)))
671
672 (defvar emus-browser-mode-map
673   (let ((map (make-sparse-keymap)))
674     (define-key map (kbd "SPC") 'emus-playpause-status)
675     (define-key map (kbd "o") 'emus-stop-status)
676     (define-key map (kbd "+") 'emus-volume-up-status)
677     (define-key map (kbd "=") 'emus-volume-up-status)
678     (define-key map (kbd "-") 'emus-volume-down-status)
679     (define-key map (kbd "R") 'emus-refresh-status)
680     (define-key map (kbd "n") 'emus-play-next-status)
681     (define-key map (kbd "p") 'emus-play-prev-status)
682     (define-key map (kbd "N") 'emus-play-next-album-status)
683     (define-key map (kbd "P") 'emus-play-prev-album-status)
684     (define-key map (kbd ",") 'emus-jump-10s-backward-status)
685     (define-key map (kbd ".") 'emus-jump-10s-forward-status)
686     (define-key map (kbd "c") 'emus-goto-current-status)
687     (when (fboundp 'evil-define-key*)
688       (evil-define-key* 'motion map
689                         (kbd "SPC") 'emus-playpause-status
690                         (kbd "o") 'emus-stop-status
691                         (kbd "+") 'emus-volume-up-status
692                         (kbd "=") 'emus-volume-up-status
693                         (kbd "-") 'emus-volume-down-status
694                         (kbd "R") 'emus-refresh-status
695                         (kbd "n") 'emus-play-next-status
696                         (kbd "p") 'emus-play-prev-status
697                         (kbd "N") 'emus-play-next-album-status
698                         (kbd "P") 'emus-play-prev-album-status
699                         (kbd ",") 'emus-jump-10s-backward-status
700                         (kbd ".") 'emus-jump-10s-forward-status
701                         (kbd "c") 'emus-goto-current-status))
702     map)
703   "Keymap for emus browser.")
704
705 (define-derived-mode emus-browser-mode special-mode "emus-browser"
706   "Major mode for EMUS music player file browser."
707   (setq-local buffer-invisibility-spec nil))
708
709 (when (fboundp 'evil-set-initial-state)
710   (evil-set-initial-state 'emus-browser-mode 'motion))
711
712 ;;; emus.el ends here