Added remaining docstrings. Flycheck now happy.
[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   '((t :inherit font-lock-string-face :background "#333"))
61   "Face used for artist names in browser.")
62
63 (defface emus-album
64   '((t :inherit font-lock-constant-face :background "#222"))
65   "Face used for album names in browser.")
66
67 (defface emus-track
68   '((t :inherit font-lock-keyword-face))
69   "Face used for track titles in browser.")
70
71 (defface emus-track-current
72   '((t :inherit font-lock-keyword-face :inverse-video t))
73   "Face used for track titles in browser.")
74
75 (defface emus-cursor
76   '((t :inherit bold))
77   "Face used for current track cursor")
78
79
80 ;;; Global variables
81
82 (defvar emus--proc-in-use nil
83   "If non-nil, disables `emus-send-cmd'.
84 Used to prevent commands from interfering with library construction.")
85
86 (defvar emus-tracks nil
87   "Emus audio library.")
88
89 (defvar emus-current-track nil
90   "Currently-selected emus track.")
91
92 (defvar emus-state 'stopped
93   "Current playback state.")
94
95 (defvar emus-continuous-playback t
96   "If non-nil, emus will automatically play the next track when the current track is finished.")
97
98 (defvar emus-current-volume 100
99   "The current playback volume.")
100
101
102 ;;; mpg123 process
103 ;;
104
105
106 (defun emus-get-process ()
107   "Return current or new mpg123 process."
108   (let* ((emus-process-raw (get-process "emus-process"))
109          (emus-process (if emus-process-raw
110                            (if (process-live-p emus-process-raw)
111                                emus-process-raw
112                              (kill-process emus-process-raw)
113                              nil))))
114     (if emus-process
115         emus-process
116       (let ((proc
117              (make-process :name "emus-process"
118                            ;; :buffer (get-buffer-create "*emus-process*")
119                            :command `(,emus-mpg123-program "-R"))))
120         (set-process-query-on-exit-flag proc nil)
121         (process-send-string proc "silence\n")
122         proc))))
123
124 (defun emus--send-cmd-raw (cmd &rest args)
125   "Send a command CMD with args ARGS to the mpg123 process.
126 This procedure does not respect `emus--proc-in-use' and thus should only
127 be used by `emus--load-library'."
128     (process-send-string (emus-get-process)
129                          (concat
130                           (seq-reduce (lambda (s1 s2) (concat s1 " " s2)) args cmd)
131                           "\n")))
132
133 (defun emus-send-cmd (cmd &rest args)
134   "Send a command CMD with args ARGS to the mpg123 process."
135   (unless emus--proc-in-use
136     (apply #'emus--send-cmd-raw cmd args)))
137
138
139 ;;; Library
140 ;;
141
142 (defun emus-get-audio-files ()
143   "Get all mp3 files in main emus directory."
144   (directory-files-recursively emus-directory ".*\\.mp3"))
145
146 (defun emus-make-track (artist album title filename &optional pos)
147   "Create an object representing an emus track.
148 ARTIST, ALBUM and TITLE are used to describe the track, FILENAME
149 refers to the mp3 file containing the track.  If non-nil, POS
150 specifies the position of the record representing this track in the
151 emus browser buffer."
152   (vector artist album title filename pos))
153
154 (defun emus-track-artist (track)
155   "The artist corresponding to TRACK."
156   (elt track 0))
157
158 (defun emus-track-album (track)
159   "The album corresponding to TRACK."
160   (elt track 1))
161
162 (defun emus-track-title (track)
163   "The title of TRACK."
164   (elt track 2))
165
166 (defun emus-track-file (track)
167   "The mp3 file corresponding to TRACK."
168   (elt track 3))
169
170 (defun emus-track-browser-pos (track)
171   "The location of the browser buffer record corresponding to TRACK."
172   (elt track 4))
173
174 (defun emus-set-track-browser-pos (track pos)
175   "Set the location of the browser buffer record corresponding to TRACK to POS."
176   (aset track 4 pos))
177
178 (defun emus--load-library (then)
179   "Initialize the emus track library.
180 Once the library is initialized, the function THEN is called."
181   (unless emus--proc-in-use
182     (setq emus--proc-in-use t)
183     (emus--suspend-cp)
184     (setq emus-state 'stopped)
185     (let ((proc (emus-get-process))
186           (tagstr "")
187           (filenames (emus-get-audio-files)))
188       (setq emus-tracks nil)
189       (set-process-filter proc (lambda (proc string)
190                                  (setq tagstr (concat tagstr string))
191                                  (when (string-suffix-p "@P 1\n" string)
192                                    (add-to-list 'emus-tracks
193                                                 (emus--make-track-from-tagstr (car filenames)
194                                                                               tagstr))
195                                    (setq tagstr "")
196                                    (setq filenames (cdr filenames))
197                                    (if filenames
198                                        (emus--send-cmd-raw "lp" (car filenames))
199                                      (set-process-filter proc nil)
200                                      (setq emus-tracks (reverse emus-tracks))
201                                      (emus--sort-tracks)
202                                      (unless emus-current-track
203                                        (setq emus-current-track (car emus-tracks)))
204                                      (funcall then)
205                                      (emus--resume-cp)
206                                      (setq emus--proc-in-use nil)))))
207       (emus--send-cmd-raw "lp" (car filenames)))))
208
209 (defun emus--make-track-from-tagstr (filename tagstr)
210   "Parse TAGSTR to populate the fields of a track corresponding to FILENAME."
211   (let ((artist "")
212         (album "")
213         (title ""))
214     (dolist (line (split-string tagstr "\n"))
215       (let ((found-artist (elt (split-string line "@I ID3v2.artist:") 1))
216             (found-album (elt (split-string line "@I ID3v2.album:") 1))
217             (found-title (elt (split-string line "@I ID3v2.title:") 1)))
218         (cond
219          (found-artist (setq artist found-artist))
220          (found-album (setq album found-album))
221          (found-title (setq title found-title)))))
222     (emus-make-track artist album title filename nil)))
223
224 (defun emus--sort-tracks ()
225   "Sort the library tracks according to artist and album.
226 Leaves the track titles unsorted, so they will appear in the order specified
227 by the filesystem."
228   (sort emus-tracks
229         (lambda (r1 r2)
230           (let ((artist1 (emus-track-artist r1))
231                 (artist2 (emus-track-artist r2)))
232             (if (string= artist1 artist2)
233                 (let ((album1 (emus-track-album r1))
234                       (album2 (emus-track-album r2)))
235                   (string< album1 album2))
236               (string< artist1 artist2))))))
237
238 (defmacro emus--with-library (&rest body)
239   "Evaluate BODY with the library initialized."
240   `(if emus-tracks
241        (progn ,@body)
242      (emus--load-library
243       (lambda () ,@body))))
244
245
246 ;;; Playback
247 ;;
248
249 (defun emus--suspend-cp ()
250   "Suspend continuous playback."
251   (setq emus-continuous-playback nil))
252
253 (defun emus--resume-cp ()
254   "Resume continuous playback."
255   (setq emus-continuous-playback t)
256   (set-process-filter (emus-get-process)
257                       (lambda (_proc string)
258                         (and emus-continuous-playback
259                              (eq emus-state 'playing)
260                              (string-suffix-p "@P 0\n" string)
261                              (emus-play-next)))))
262
263 (defun emus-play-track (track)
264   "Set TRACK as current and start playing."
265   (emus--with-library
266    (let ((old-track emus-current-track))
267      (emus-send-cmd "l" (emus-track-file track))
268      (setq emus-state 'playing)
269      (setq emus-current-track track)
270      (emus--update-track old-track)
271      (emus--update-track track)
272      (emus--resume-cp))))
273
274 (defun emus-select-track (track)
275   "Set TRACK as current, but do not start playing."
276   (emus--with-library
277    (let ((old-track emus-current-track))
278      (setq emus-state 'stopped)
279      (setq emus-current-track track)
280      (emus--update-track old-track)
281      (emus--update-track track)
282      (emus-send-cmd "o")
283      (emus--resume-cp))))
284
285 (defun emus-stop ()
286   "Stop playback of the current track."
287   (interactive)
288   (emus--with-library
289    (setq emus-state 'stopped)
290    (emus--update-track emus-current-track)
291    (emus-send-cmd "s")))
292
293 (defun emus-playpause ()
294   "Begin playback of the current track.
295 If the track is already playing, pause playback.
296 If the track is currently paused, resume playback."
297   (interactive)
298   (emus--with-library
299    (when emus-current-track
300      (if (eq emus-state 'stopped)
301          (emus-play-track emus-current-track)
302        (emus-send-cmd "p")
303        (pcase emus-state
304          ((or 'paused 'stopped) (setq emus-state 'playing))
305          ('playing (setq emus-state 'paused)))
306        (unless (eq emus-state 'paused)))
307      (emus--update-track emus-current-track))))
308
309 (defun emus-set-volume (pct)
310   "Set the playback volume to PCT %."
311   (emus--with-library
312    (setq emus-current-volume pct)
313    (emus-send-cmd "v" (number-to-string pct))))
314
315 (defun emus-volume-increase-by (delta)
316   "Increase the playback volume by DELTA %."
317   (emus-set-volume (max 0 (min 100 (+ emus-current-volume delta)))))
318
319 (defun emus-volume-up ()
320   "Increase the playback volume by 10%."
321   (interactive)
322   (emus-volume-increase-by 10))
323
324 (defun emus-volume-down ()
325   "Decrease the playback volume by 10%."
326   (interactive)
327   (emus-volume-increase-by -10))
328
329 (defun emus--play-adjacent-track (&optional prev)
330   "Play the next track in the library, or the previous if PREV is non-nil."
331   (emus--with-library
332    (let ((idx (seq-position emus-tracks emus-current-track))
333          (offset (if prev -1 +1)))
334      (if idx
335          (let ((next-track (elt emus-tracks (+ idx offset))))
336            (if next-track
337                (if (eq emus-state 'playing)
338                    (emus-play-track next-track)
339                  (emus-select-track next-track))
340              (error "Track does not exist")))
341        (error "No track selected")))))
342
343 (defun emus--play-adjacent-album (&optional prev)
344   "Play the first track of the next album in the library.
345 If PREV is non-nil, plays the last track of the previous album."
346   (emus--with-library
347    (let ((idx (seq-position emus-tracks emus-current-track)))
348      (if idx
349          (let* ((search-list (if prev
350                                  (reverse (seq-subseq emus-tracks 0 idx))
351                                (seq-subseq emus-tracks (+ idx 1))))
352                 (current-album (emus-track-album emus-current-track))
353                 (next-track (seq-some (lambda (r)
354                                         (if (string= (emus-track-album r)
355                                                      current-album)
356                                             nil
357                                           r))
358                                       search-list)))
359            (if next-track
360                (if (eq emus-state 'playing)
361                    (emus-play-track next-track)
362                  (emus-select-track next-track))
363              (error "Track does not exist")))
364        (error "No track selected")))))
365
366 (defun emus-play-next ()
367   "Play the next track in the library."
368   (interactive)
369   (emus--play-adjacent-track))
370
371 (defun emus-play-prev ()
372   "Play the previous track in the library."
373   (interactive)
374   (emus--play-adjacent-track t))
375
376 (defun emus-play-next-album ()
377   "Play the first track of the next album in the library."
378   (interactive)
379   (emus--play-adjacent-album))
380
381 (defun emus-play-prev-album ()
382   "Play the last track of the previous album in the library."
383   (interactive)
384   (emus--play-adjacent-album t))
385
386 (defun emus-jump (seconds)
387   "Jump forward in current track by SECONDS seconds."
388   (emus--with-library
389    (emus-send-cmd "jump" (format "%+ds" seconds))))
390
391 (defun emus-jump-10s-forward ()
392   "Jump 10 seconds forward in current track."
393   (interactive)
394   (emus-jump 10))
395
396 (defun emus-jump-10s-backward ()
397   "Jump 10 seconds backward in current track."
398   (interactive)
399   (emus-jump -10))
400
401 (defun emus-display-status ()
402   "Display the current playback status in the minibuffer."
403   (interactive)
404   (emus--with-library
405    (message
406     (concat "Emus: Volume %d%%"
407             (pcase emus-state
408               ('stopped " [Stopped]")
409               ('paused " [Paused]")
410               ('playing " [Playing]")
411               (_ ""))
412             (if emus-current-track
413                 (format " - %.30s (%.20s)"
414                         (emus-track-title emus-current-track)
415                         (emus-track-artist emus-current-track))
416               ""))
417     emus-current-volume)))
418
419
420 ;;; Browser
421 ;;
422
423 (defun emus--insert-track (track &optional prev-track first)
424   "Insert a button representing TRACK into the current buffer.
425
426 When provided, PREV-TRACK is used to determine whether to insert additional
427 headers representing the artist or the album title.
428
429 If non-nil, FIRST indicates that the track is the first in the library
430 and thus requires both artist and album headers."
431   (let* ((artist (emus-track-artist track))
432          (album (emus-track-album track))
433          (title (emus-track-title track))
434          (help-str (format "mouse-1, RET: Play '%.30s' (%.20s)" title artist)))
435     (when (or prev-track first)
436       (unless (equal (emus-track-artist prev-track) artist)
437         (insert-text-button
438          (propertize artist 'face 'emus-artist)
439          'action #'emus--click-track
440          'follow-link t
441          'help-echo help-str
442          'emus-track track)
443         (insert (propertize "\n" 'face 'emus-artist)))
444       (unless (equal (emus-track-album prev-track) album)
445         (insert-text-button
446          (propertize (concat "  " album) 'face 'emus-album)
447          'action #'emus--click-track
448          'follow-link t
449          'help-echo help-str
450          'emus-track track)
451         (insert (propertize "\n" 'face 'emus-album))))
452     (emus-set-track-browser-pos track (point))
453     (let ((is-current (equal track emus-current-track)))
454       (insert-text-button
455        (concat
456         (if is-current
457             (propertize
458              (pcase emus-state
459                ('playing "->")
460                ('paused "-)")
461                ('stopped "-]"))
462              'face 'emus-cursor)
463           (propertize "  " 'face 'default))
464         (propertize (format "   %s" title)
465                     'face (if is-current
466                               'emus-track-current
467                             'emus-track)))
468        'action #'emus--click-track
469        'follow-link t
470        'help-echo help-str
471        'emus-track track)
472       (insert (propertize "\n"
473                           'face (if is-current
474                                     'emus-track-current
475                                   'emus-track))))))
476
477 (defun emus--update-track (track)
478   "Rerender entry for TRACK in emus browser buffer.
479 Used to update browser display when `emus-current-track' and/or `emus-state' changes."
480   (let ((track-pos (emus-track-browser-pos track)))
481     (when (and (get-buffer "*emus*")
482                (emus-track-browser-pos track))
483       (with-current-buffer "*emus*"
484         (let ((inhibit-read-only t)
485               (old-point (point)))
486           (goto-char track-pos)
487           (search-forward "\n")
488           (delete-region track-pos (point))
489           (goto-char track-pos)
490           (emus--insert-track track)
491           (goto-char old-point))))))
492
493 (defun emus--render-tracks ()
494   "Render all library tracks in emus browser buffer."
495   (with-current-buffer "*emus*"
496     (let ((inhibit-read-only t)
497           (old-pos (point)))
498       (erase-buffer)
499       (goto-char (point-min))
500       (let ((prev-track nil))
501         (dolist (track emus-tracks)
502           (emus--insert-track track prev-track (not prev-track))
503           (setq prev-track track)))
504       (goto-char old-pos))))
505
506 (defun emus--click-track (button)
507   "Begin playback of track indicated by BUTTON."
508   (emus-play-track (button-get button 'emus-track))
509   (emus-display-status))
510
511 (defun emus-centre-current ()
512   "Centre the current track in the browser buffer, if available."
513   (interactive)
514   (when (get-buffer "*emus*")
515       (when emus-current-track
516         (goto-char (emus-track-browser-pos emus-current-track))
517         (recenter))))
518
519 (defun emus-browse ()
520   "Switch to *emus* audio library browser."
521   (interactive)
522   (emus--with-library
523    (switch-to-buffer "*emus*")
524    (emus-browser-mode)
525    (emus--render-tracks)
526    (emus-centre-current)))
527
528 (defun emus-refresh ()
529   "Refresh the emus library."
530   (interactive)
531   (emus-stop)
532   (setq emus-tracks nil)
533   (emus-browse))
534
535
536 ;;; Playback + status display commands
537 ;;
538
539 (defun emus-playpause-status ()
540   "Start, pause or resume playback, then display the emus status in the minibuffer."
541   (interactive)
542   (emus-playpause)
543   (emus-display-status))
544
545 (defun emus-stop-status ()
546   "Stop playback, then display the emus status in the minibuffer."
547   (interactive)
548   (emus-stop)
549   (emus-display-status))
550
551 (defun emus-volume-up-status ()
552   "Increase volume by 10%, then display the emus status in the minibuffer."
553   (interactive)
554   (emus-volume-up)
555   (emus-display-status))
556
557 (defun emus-volume-down-status ()
558   "Decrease volume by 10%, then display the emus status in the minibuffer."
559   (interactive)
560   (emus-volume-down)
561   (emus-display-status))
562
563 (defun emus-play-next-status ()
564   "Play next track, then display the emus status in the minibuffer."
565   (interactive)
566   (emus-play-next)
567   (emus-display-status))
568
569 (defun emus-play-prev-status ()
570   "Play previous track, then display the emus status in the minibuffer."
571   (interactive)
572   (emus-play-prev)
573   (emus-display-status))
574
575 (defun emus-play-next-album-status ()
576   "Play first track of next album, then display the emus status in the minibuffer."
577   (interactive)
578   (emus-play-next-album)
579   (emus-display-status))
580
581 (defun emus-play-prev-album-status ()
582   "Play last track of previous album, then display the emus status in the minibuffer."
583   (interactive)
584   (emus-play-prev-album)
585   (emus-display-status))
586
587 (defun emus-jump-10s-forward-status ()
588   "Jump 10s forward in current track, then display the emus status in the minibuffer."
589   (interactive)
590   (emus-jump-10s-forward)
591   (emus-display-status))
592
593 (defun emus-jump-10s-backward-status ()
594   "Jump 10s backward in current track, then display the emus status in the minibuffer."
595   (interactive)
596   (emus-jump-10s-backward)
597   (emus-display-status))
598
599 (defun emus-centre-current-status ()
600   "Jump 10s backward in current track, then display the emus status in the minibuffer."
601   (interactive)
602   (emus-centre-current)
603   (emus-display-status))
604
605 (defun emus-refresh-status ()
606   "Refresh the emus library, then display the emus status in the minibuffer."
607   (interactive)
608   (emus-stop)
609   (setq emus-tracks nil)
610   (emus--with-library
611    (emus-browse)
612    (emus-display-status)))
613
614 (defvar emus-browser-mode-map
615   (let ((map (make-sparse-keymap)))
616     (define-key map (kbd "SPC") 'emus-playpause-status)
617     (define-key map (kbd "o") 'emus-stop-status)
618     (define-key map (kbd "+") 'emus-volume-up-status)
619     (define-key map (kbd "=") 'emus-volume-up-status)
620     (define-key map (kbd "-") 'emus-volume-down-status)
621     (define-key map (kbd "R") 'emus-refresh-status)
622     (define-key map (kbd "n") 'emus-play-next-status)
623     (define-key map (kbd "p") 'emus-play-prev-status)
624     (define-key map (kbd "N") 'emus-play-next-album-status)
625     (define-key map (kbd "P") 'emus-play-prev-album-status)
626     (define-key map (kbd ",") 'emus-jump-10s-backward-status)
627     (define-key map (kbd ".") 'emus-jump-10s-forward-status)
628     (define-key map (kbd "c") 'emus-centre-current-status)
629     (when (fboundp 'evil-define-key*)
630       (evil-define-key* 'motion map
631                         (kbd "SPC") 'emus-playpause-status
632                         (kbd "o") 'emus-stop-status
633                         (kbd "+") 'emus-volume-up-status
634                         (kbd "=") 'emus-volume-up-status
635                         (kbd "-") 'emus-volume-down-status
636                         (kbd "R") 'emus-refresh-status
637                         (kbd "n") 'emus-play-next-status
638                         (kbd "p") 'emus-play-prev-status
639                         (kbd "N") 'emus-play-next-album-status
640                         (kbd "P") 'emus-play-prev-album-status
641                         (kbd ",") 'emus-jump-10s-backward-status
642                         (kbd ".") 'emus-jump-10s-forward-status
643                         (kbd "c") 'emus-centre-current-status))
644     map)
645   "Keymap for emus browser.")
646
647 (define-derived-mode emus-browser-mode special-mode "emus-browser"
648   "Major mode for EMUS music player file browser.")
649
650 (when (fboundp 'evil-set-initial-state)
651   (evil-set-initial-state 'emus-browser-mode 'motion))
652
653 ;;; emus.el ends here