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