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