cgit.sxemacs.org Git - slh/blob - mpd.el

   1 ;;; mpd.el --- A complete ripoff of xwem-mpd.
   2
   3 ;; Copyright (C) 2008 - 2013 Steve Youngs
   4
   5 ;; Original xwem-mpd:
   6 ;; Copyright (C) 2005 Richard Klinda
   7 ;; Author: Richard Klinda <ignotus@freemail.hu>
   8 ;;         Zajcev Evgeny <zevlg@yandex.ru>
   9 ;; Created: 2004
  10
  11 ;; Keywords: music, entertainment
  12
  13 ;; This file is NOT part of anything.
  14
  15 ;; The original xwem-mpd.el was released under the terms of the GPLv2.
  16 ;; mpd.el uses the BSD licence.
  17
  18 ;; Redistribution and use in source and binary forms, with or without
  19 ;; modification, are permitted provided that the following conditions
  20 ;; are met:
  21 ;;
  22 ;; 1. Redistributions of source code must retain the above copyright
  23 ;;    notice, this list of conditions and the following disclaimer.
  24 ;;
  25 ;; 2. Redistributions in binary form must reproduce the above copyright
  26 ;;    notice, this list of conditions and the following disclaimer in the
  27 ;;    documentation and/or other materials provided with the distribution.
  28 ;;
  29 ;; 3. Neither the name of the author nor the names of any contributors
  30 ;;    may be used to endorse or promote products derived from this
  31 ;;    software without specific prior written permission.
  32 ;;
  33 ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
  34 ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  35 ;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  36 ;; DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
  37 ;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
  38 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
  39 ;; SUBSTITUTE GOODS OR SERVICES# LOSS OF USE, DATA, OR PROFITS# OR
  40 ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  41 ;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
  42 ;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
  43 ;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  44
  45 ;;; Commentary:
  46
  47 ;; You need MusicPD - Music Playing Daemon
  48 ;; (http://www.musicpd.org/) to be set up and running.
  49
  50 ;; The xwem-mpd-dock from xwem-mpd.el was designed to sit in the xwem
  51 ;; minibuffer (panel), and theoretically you would be able to have the
  52 ;; mpd-dock-frame from here sit in a panel (KDE, GNOME, LXDE, etc)
  53 ;; too.  I say "theoretically" because I've never tried so I'm leaving
  54 ;; it as an exercise for the reader. :-)
  55
  56 ;; No, instead of docking the mpd-dock-frame onto a panel I prefer to
  57 ;; tweak its frame properties so it will be completely ignored by the
  58 ;; WM.  That gives me a frame that has no decorations, is visible on all
  59 ;; workspaces, always "on top", and doesn't show up in "task switchers".
  60 ;; To get tha magic you set the `override-redirect' property to `t', and
  61 ;; for positioning set `left' and/or `top' properties.
  62
  63 ;;; Keybinding Suggestions:
  64 ;;
  65 ;;  (global-set-key [XF86AudioPlay] #'mpd-playpause)
  66 ;;  (global-set-key [XF86AudioStop] #'mpd-stop)
  67 ;;  (global-set-key [XF86AudioNext] #'mpd-next-track)
  68 ;;  (global-set-key [XF86AudioPrev] #'mpd-previous-track)
  69 ;;  (global-set-key [XF86AudioRaiseVolume] #'mpd-volume-up)
  70 ;;  (global-set-key [XF86AudioLowerVolume] #'mpd-volume-down)
  71 ;;  (global-set-key [XF86AudioMute] #'mpd-volume-mute/unmute)
  72 ;;
  73 ;; Yeah, it helps if you have a keyboard with those fancy keys. :-)
  74
  75 ;;; Cover Art:
  76 ;;
  77 ;; First up you will need a 48x48 `nocover.jpg' and put it in
  78 ;; `mpd-directory' (see the images directory in this repo) for albums
  79 ;; that you don't have any art for.  Secondly, album art is taken from
  80 ;; `cover.jpg' files in the same directory as the album's audio files.
  81 ;; Yep, sort your music by album (at least).
  82 ;;
  83 ;; Embedded art is not supported at this time, but hopefully one day.
  84
  85 ;;; Player control buttons:
  86 ;;
  87 ;; Put the XPM's in `mpd-directory'
  88
  89 ;;; Code:
  90 \f
  91 (defgroup mpd nil
  92   "Group to customize mpd."
  93   :prefix "mpd-"
  94   :group 'hypermedia)
  95
  96 (defcustom mpd-update-rate 5
  97   "MPD variables updating rate in seconds."
  98   :type 'number
  99   :group 'mpd)
 100
 101 (defcustom mpd-directory
 102   (file-name-as-directory
 103    (expand-file-name ".mpd" (user-home-directory)))
 104   "Base mpd directory."
 105   :type 'directory
 106   :group 'mpd)
 107
 108 (defcustom mpd-conf-file
 109   (let ((locations
 110          (list (expand-file-name
 111                 "mpd.conf"
 112                 (paths-construct-path (list (getenv "XDG_CONFIG_HOME") "mpd")))
 113                (expand-file-name ".mpdconf" (user-home-directory))
 114                (expand-file-name
 115                 "mpd.conf"
 116                 (paths-construct-path (list (user-home-directory) ".mpd")))
 117                (expand-file-name "mpd.conf" "/etc"))))
 118     (catch 'conf
 119       (mapcar #'(lambda (file)
 120                   (and (file-exists-p file)
 121                        (throw 'conf file)))
 122               locations)))
 123   "The mpd config file.
 124
 125 The default should be fine here because the file is searched for in
 126 the same places and in the same order as mpd itself does."
 127   :type '(file :must-match t)
 128   :group 'mpd)
 129
 130 (defcustom mpd-after-command-hook nil
 131   "Hooks to run after MPD command is executed.
 132 Executed command name stored in `mpd-this-command'."
 133   :type 'hook
 134   :group 'mpd)
 135
 136 (defcustom mpd-before-variables-update-hook nil
 137   "Hooks to run before updating mpd variables."
 138   :type 'hook
 139   :group 'mpd)
 140
 141 (defcustom mpd-after-variables-update-hook nil
 142   "Hooks to run after mpd variables has been updated."
 143   :type 'hook
 144   :group 'mpd)
 145
 146 \f
 147 (defvar mpd-process nil)
 148 (defvar mpd-itimer nil)
 149 (defvar mpd-dock-frame nil)
 150 (defvar mpd-dock-buffer nil)
 151
 152 (defun mpd-start-connection ()
 153   "Open connection to MusicPD daemon.
 154 Set `mpd-process' by side effect."
 155   (when (or (not mpd-process)
 156             (not (eq mpd-process 'open)))
 157     (setq mpd-process (open-network-stream "mpd" " *mpd connection*"
 158                                            "localhost" 6600))
 159     (when (fboundp 'set-process-coding-system)
 160       (set-process-coding-system mpd-process 'utf-8 'utf-8))
 161     (set-process-filter mpd-process 'mpd-process-filter)
 162     (set-process-sentinel mpd-process 'mpd-process-sentinel)
 163     (process-kill-without-query mpd-process)
 164
 165     (add-hook 'mpd-after-command-hook #'mpd-update-variables)
 166     (setq mpd-itimer
 167           (start-itimer "mpd-vars-update" #'mpd-update-variables
 168                         mpd-update-rate mpd-update-rate))))
 169
 170 (defun mpd-disconnect ()
 171   "Disconnect from the mpd daemon.
 172
 173 Also removes the update hook, kills the itimer, and removes the dock
 174 frame."
 175   (interactive)
 176   (let ((proc (get-process (process-name mpd-process)))
 177         (timer (get-itimer (itimer-name mpd-itimer))))
 178     (remove-hook 'mpd-after-command-hook #'mpd-update-variables)
 179     (when (itimerp timer)
 180       (delete-itimer timer))
 181     (when (process-live-p proc)
 182       (delete-process (get-process (process-name mpd-process))))
 183     (when (frame-live-p mpd-dock-frame)
 184       (delete-frame mpd-dock-frame))
 185     (when (buffer-live-p mpd-dock-buffer)
 186       (kill-buffer mpd-dock-buffer))))
 187
 188 (defun mpd-music-directory ()
 189   "Returns the value of \"music_directory\" from mpd config."
 190   (with-current-buffer (find-file-noselect mpd-conf-file)
 191     (re-search-forward "^music_directory[[:blank:]]+" nil t)
 192     (buffer-substring (1+ (point)) (1- (point-at-eol)))))
 193
 194 (defvar mpd-music-directory (mpd-music-directory)
 195   "The music directory.")
 196
 197 ;; mpd variables
 198 (defvar mpd-zero-vars-p t)
 199 (defvar mpd-status-update-p nil)
 200
 201 (defvar **mpd-var-Album* nil)
 202 (defvar **mpd-var-Artist* nil)
 203 (defvar **mpd-var-Date* nil)
 204 (defvar **mpd-var-Genre* nil)
 205 (defvar **mpd-var-Id* nil)
 206 (defvar **mpd-var-Pos* nil)
 207 (defvar **mpd-var-Time* nil)
 208 (defvar **mpd-var-Title* nil)
 209 (defvar **mpd-var-Track* nil)
 210 (defvar **mpd-var-audio* nil)
 211 (defvar **mpd-var-bitrate* nil)
 212 (defvar **mpd-var-file* nil)
 213 (defvar **mpd-var-length* nil)
 214 (defvar **mpd-var-playlist* nil)
 215 (defvar **mpd-var-playlistlength* nil)
 216 (defvar **mpd-var-random* nil)
 217 (defvar **mpd-var-repeat* nil)
 218 (defvar **mpd-var-song* nil)
 219 (defvar **mpd-var-songid* nil)
 220 (defvar **mpd-var-state* nil)
 221 (defvar **mpd-var-time* nil)
 222 (defvar **mpd-var-volume* nil)
 223 (defvar **mpd-var-xfade* nil)
 224
 225 (defvar mpd-pre-mute-volume nil
 226   "Holds the value of `**mpd-var-volume* prior to muting.
 227 The purpose of this is so that when you unmute, it goes back to the
 228 volume you had it set to before you muted.")
 229
 230 (defvar mpd-this-command nil
 231   "The mpd command currently executing.
 232 Useful to use in `mpd-after-command-hook' hooks.")
 233
 234 (defmacro define-mpd-command (cmd args &rest body)
 235   "Define new mpd command."
 236   `(defun ,cmd ,args
 237      ,@body
 238      (let ((mpd-this-command ',cmd))
 239        (run-hooks 'mpd-after-command-hook))))
 240
 241 (defun mpd-send (format &rest args)
 242   "Send formated string into connection.
 243 FORMAT and ARGS are passed directly to `format' as arguments."
 244   (let ((string (concat (apply #'format format args) "\n")))
 245     (if (eq (process-status mpd-process) 'open)
 246         (process-send-string mpd-process string)
 247       (mpd-start-connection)
 248       (process-send-string mpd-process string))))
 249
 250 (defun mpd-stopped-p ()
 251   (string= **mpd-var-state* "stop"))
 252 (defun mpd-paused-p ()
 253   (string= **mpd-var-state* "pause"))
 254 (defun mpd-muted-p ()
 255   (zerop (string-to-number **mpd-var-volume*)))
 256
 257 ;; (mpd-songpos)
 258 (defun mpd-songpos ()
 259   (if **mpd-var-time*
 260       (destructuring-bind (a b)
 261           (split-string **mpd-var-time* ":")
 262         (cons (string-to-int a) (string-to-int b)))
 263     (cons 0 1)))                        ; todo?
 264
 265 (defun mpd-volume-up (step)
 266   "Increase the volume by STEP increments.
 267 STEP can be given via numeric prefix arg and defaults to 1 if omitted."
 268   (interactive "p")
 269   (let* ((oldvol (string-to-number **mpd-var-volume*))
 270          (newvol (+ oldvol step))
 271          (mpd-this-command 'mpd-volume-down))
 272     (when (>= newvol 100)
 273       (setq newvol 100))
 274     (mpd-send "setvol %d" newvol)
 275     (run-hooks 'mpd-after-command-hook)))
 276
 277 (defun mpd-volume-down (step)
 278   "Decrease the volume by STEP increments.
 279 STEP can be given via numeric prefix arg and defaults to 1 if omitted."
 280   (interactive "p")
 281   (let* ((oldvol (string-to-number **mpd-var-volume*))
 282          (newvol (- oldvol step))
 283          (mpd-this-command 'mpd-volume-down))
 284     (when (<= newvol 0)
 285       (setq newvol 0))
 286     (mpd-send "setvol %d" newvol)
 287     (run-hooks 'mpd-after-command-hook)))
 288
 289 (defun mpd-volume-mute (&optional unmute)
 290   "Mute the volume.
 291 With prefix arg, UNMUTE, let the tunes blast again."
 292   (interactive "P")
 293   (if unmute
 294       (mpd-send "setvol %s" mpd-pre-mute-volume)
 295     (setq mpd-pre-mute-volume **mpd-var-volume*)
 296     (mpd-send "setvol 0"))
 297   (let ((mpd-this-command 'mpd-volume-mute))
 298     (run-hooks 'mpd-after-command-hook)))
 299
 300 (defun mpd-volume-mute/unmute ()
 301   "Wrapper around #'mpd-volume-mute to mute and unmute."
 302   (interactive)
 303   (if (mpd-muted-p)
 304       (mpd-volume-mute 'unmute)
 305     (mpd-volume-mute)))
 306
 307 (define-mpd-command mpd-volume-max ()
 308   "Set volume to maximum."
 309   (interactive)
 310   (mpd-send "setvol 100"))
 311
 312 (define-mpd-command mpd-volume-min ()
 313   "Set volume to minimum.
 314 Sets state to \"muted\" by side effect."
 315   (interactive)
 316   (setq mpd-pre-mute-volume **mpd-var-volume*)
 317   (mpd-send "setvol 0"))
 318
 319 (define-mpd-command mpd-seek (time)
 320   "Seek current track to TIME."
 321   (mpd-send "seekid %s %d" **mpd-var-Id* (+ (car (mpd-songpos)) time)))
 322
 323 (defun mpd-seek-forward ()
 324   (interactive)
 325   (mpd-seek 10))
 326
 327 (defun mpd-seek-backward ()
 328   (interactive)
 329   (mpd-seek -10))
 330
 331 ;; Plaing operations
 332 (define-mpd-command mpd-next-track ()
 333   "Start playing next track."
 334   (interactive)
 335   (mpd-send "next"))
 336
 337 (define-mpd-command mpd-previous-track ()
 338   "Start playing previous track."
 339   (interactive)
 340   (mpd-send "previous"))
 341
 342 (define-mpd-command mpd-stop ()
 343   "Stop playing."
 344   (interactive)
 345   (mpd-send "stop"))
 346
 347 (define-mpd-command mpd-play ()
 348   "Start playing."
 349   (interactive)
 350   (mpd-send "play"))
 351
 352 (define-mpd-command mpd-pause ()
 353   "Pause playing."
 354   (interactive)
 355   (mpd-send "pause"))
 356
 357 (define-mpd-command mpd-playpause ()
 358   "Resume playing or pause."
 359   (interactive)
 360   (if (mpd-stopped-p)
 361       (mpd-send "play")
 362     (mpd-send "pause")))
 363
 364 (defun mpd-process-filter (process output)
 365   "MPD proccess filter."
 366   (with-temp-buffer
 367     (insert output)
 368     (goto-char (point-min))
 369     (while (not (eobp))
 370       (when (looking-at "\\(.*?\\): \\(.*\\)")
 371         (set (intern (format "**mpd-var-%s*" (match-string 1)))
 372              (match-string 2)))
 373       (forward-line 1)))
 374   (when mpd-status-update-p
 375     (setq mpd-status-update-p nil)
 376     (setq mpd-zero-vars-p nil)
 377     (run-hooks 'mpd-after-variables-update-hook)))
 378
 379 (defun mpd-process-sentinel (proc &optional evstr)
 380   (let ((timer (get-itimer mpd-itimer)))
 381     (message "[MPD]: %s" evstr)
 382     (delete-process proc)
 383     (when (itimerp timer)
 384       (delete-itimer timer))
 385     (setq mpd-itimer nil
 386           mpd-process nil)))
 387
 388 (defvar mpd-cover-glyph nil
 389   "The extent holding the album cover art.")
 390
 391 (defun mpd-update-cover ()
 392   "Updates the cover art glyph."
 393   (with-current-buffer mpd-dock-buffer
 394     (let* ((songdir (file-dirname **mpd-var-file*))
 395            (cover (expand-file-name
 396                    "cover.jpg"
 397                    (paths-construct-path
 398                     (list mpd-music-directory songdir))))
 399            (nocover (expand-file-name "nocover.jpg" mpd-directory))
 400            (scaled))
 401       (if (file-exists-p cover)
 402           (progn
 403             (with-temp-buffer
 404               (shell-command (concat "jpegtopnm " "'" cover "' 2>/dev/null"
 405                                      "|pnmnorm 2>/dev/null"
 406                                      "|pnmscale -height 48 -width 48"
 407                                      "|pnmtojpeg")
 408                              'insert)
 409               (setq scaled (buffer-string)))
 410             (set-extent-end-glyph
 411              mpd-cover-glyph
 412              (make-glyph (list (vector 'jpeg :data scaled)))))
 413         (set-extent-end-glyph
 414          mpd-cover-glyph
 415          (make-glyph (list (vector 'jpeg :file nocover))))))))
 416
 417 (defun mpd-update-variables ()
 418   "Requests status information."
 419   (run-hooks 'mpd-before-variables-update-hook)
 420   (setq mpd-zero-vars-p t)
 421   (mpd-send "currentsong")
 422   (setq mpd-status-update-p t)
 423   (mpd-send "status")
 424   (mpd-update-cover))
 425
 426 \f
 427 ;;;; Dockapp section
 428 (defvar mpd-dock-frame-plist
 429   '((name . "MpdDock")
 430     (height . 3)
 431     (width . 13)
 432     (unsplittable . t)
 433     (minibuffer . none)
 434     (menubar-visible-p . nil)
 435     (has-modeline-p . nil)
 436     (default-gutter-visible-p . nil)
 437     (default-toolbar-visible-p . nil)
 438     (scrollbar-height . 0)
 439     (scrollbar-width . 0)
 440     (text-cursor-visible-p . nil))
 441   "Frame properties for mpd dock.")
 442
 443 (defun mpd-info (&rest args)
 444   (let ((title (or **mpd-var-Title* "Unknown"))
 445         (artist (or **mpd-var-Artist* "Unknown"))
 446         (album (or **mpd-var-Album* "Unknown"))
 447         (genre (or **mpd-var-Genre* "Unknown"))
 448         (year (or **mpd-var-Date* "Unknown"))
 449         (file (file-name-nondirectory **mpd-var-file*)))
 450     (format "--[ %s ]\n
 451 Artist: %s
 452 Album: %s
 453 Year: %s  Genre: %s\n
 454 --[ %s ]"
 455             title artist album year genre file)))
 456
 457 (defconst mpd-prev-map
 458   (let* ((map (make-sparse-keymap 'mpd-prev-map)))
 459     (define-key map [button1] 'mpd-previous-track)
 460     map)
 461   "Keymap for \"Prev\" button.")
 462
 463 (defconst mpd-pause-map
 464   (let* ((map (make-sparse-keymap 'mpd-pause-map)))
 465     (define-key map [button1] 'mpd-pause)
 466     map)
 467   "Keymap for \"Pause\" button.")
 468
 469 (defconst mpd-play-map
 470   (let* ((map (make-sparse-keymap 'mpd-play-map)))
 471     (define-key map [button1] 'mpd-play)
 472     map)
 473   "Keymap for \"Play\" button.")
 474
 475 (defconst mpd-next-map
 476   (let* ((map (make-sparse-keymap 'mpd-next-map)))
 477     (define-key map [button1] 'mpd-next-track)
 478     map)
 479   "Keymap for \"Next\" button.")
 480
 481 (defun mpd-new-frame ()
 482   "Create new mpd frame."
 483   (unless (frame-live-p mpd-dock-frame)
 484     (setq mpd-dock-frame (new-frame mpd-dock-frame-plist))
 485     (select-frame mpd-dock-frame)
 486     (unless (buffer-live-p mpd-dock-buffer)
 487       (setq mpd-dock-buffer (get-buffer-create "*MpdDock*"))
 488       (set-buffer-dedicated-frame mpd-dock-buffer mpd-dock-frame)
 489       (save-excursion
 490         (let (prev pause play next)
 491           (set-buffer mpd-dock-buffer)
 492           (set-extent-end-glyph
 493            (setq prev (make-extent (point-max) (point-max)))
 494            (make-glyph
 495             (list (vector 'xpm :file (expand-file-name "Rewind.xpm"
 496                                                        mpd-directory)))))
 497           (set-extent-properties
 498            prev
 499            `(keymap ,mpd-prev-map balloon-help "Previous Track"))
 500           (set-extent-end-glyph
 501            (setq pause (make-extent (point-max) (point-max)))
 502            (make-glyph
 503             (list (vector 'xpm :file (expand-file-name "Pause.xpm"
 504                                                        mpd-directory)))))
 505           (set-extent-properties
 506            pause
 507            `(keymap ,mpd-pause-map balloon-help "Pause"))
 508           (set-extent-end-glyph
 509            (setq play (make-extent (point-max) (point-max)))
 510            (make-glyph
 511             (list (vector 'xpm :file (expand-file-name "Play.xpm"
 512                                                        mpd-directory)))))
 513           (set-extent-properties
 514            play
 515            `(keymap ,mpd-play-map balloon-help "Play"))
 516           (set-extent-end-glyph
 517            (setq next (make-extent (point-max) (point-max)))
 518            (make-glyph
 519             (list (vector 'xpm :file (expand-file-name "FFwd.xpm"
 520                                                        mpd-directory)))))
 521           (set-extent-properties
 522            next
 523            `(keymap ,mpd-next-map balloon-help "Next Track"))
 524           (insert " ")
 525           (set-extent-end-glyph
 526            (setq mpd-cover-glyph (make-extent (point-max) (point-max)))
 527            (make-glyph
 528             (list (vector 'jpeg :file (expand-file-name "nocover.jpg"
 529                                                         mpd-directory)))))
 530           (set-extent-properties
 531            mpd-cover-glyph
 532            `(keymap ,mpd-pause-map balloon-help ,#'mpd-info)))))
 533     (set-specifier horizontal-scrollbar-visible-p nil
 534                    (cons mpd-dock-frame nil))
 535     (set-specifier vertical-scrollbar-visible-p nil
 536                    (cons mpd-dock-frame nil))
 537     (set-window-buffer nil mpd-dock-buffer)))
 538
 539 (defun mpd ()
 540   "Start mpd dockapp to interact with MusicPD."
 541   (interactive)
 542   (let ((cframe (selected-frame)))
 543     ;; Start client connection
 544     (mpd-start-connection)
 545     (mpd-new-frame)
 546     (focus-frame cframe)
 547     (mpd-update-variables)))
 548
 549
 550 (provide 'mpd)
 551
 552 ;;; mpd.el ends here