;;; naviel.el --- Navidrome music player client for Emacs -*- lexical-binding: t -*- ;; Author: CdatGoose ;; Version: 0.1 ;; Package-Requires: ((emacs "28.1")) ;; Keywords: multimedia, music ;;; Commentary: ;; A Navidrome client for Emacs using the Subsonic API. ;; Plays music via mpv (must be installed on PATH). ;; This project is glued tegether by sheer hope, I don't know elisp and probably never will. ;; Quick setup: ;; 1. ~/.authinfo: machine your-host login USER password PASS ;; 2. (setq naviel-url "http://host:4533") ;; 3. M-x naviel (require 'url) (require 'url-util) (require 'xml) (require 'auth-source) (require 'cl-lib) (require 'json) ;;; Customisation (defgroup naviel nil "Naviel music client." :group 'multimedia :prefix "naviel-") (defcustom naviel-url "http://localhost:4533" "Base URL of the Navidrome server (no trailing slash)." :type 'string :group 'naviel) (defcustom naviel-username nil "Username. If nil, looked up from ~/.authinfo." :type '(choice (const nil) string) :group 'naviel) (defcustom naviel-password nil "Password. If nil, looked up from ~/.authinfo." :type '(choice (const nil) string) :group 'naviel) (defcustom naviel-client-name "naviel.el" "Client identifier sent with every API request." :type 'string :group 'naviel) (defcustom naviel-api-version "1.16.1" "Subsonic API version declared in requests." :type 'string :group 'naviel) (defcustom naviel-mpv-executable "mpv" "Path to the mpv executable." :type 'string :group 'naviel) (defcustom naviel-volume-step 5 "Volume increment/decrement step (0-100)." :type 'integer :group 'naviel) (defcustom naviel-seek-step 10 "Seek step in seconds for the < / > keys." :type 'integer :group 'naviel) (defcustom naviel-position-poll-interval 1.0 "Seconds between IPC polls for playback position." :type 'float :group 'naviel) ;;; Faces (defface naviel-header-face '((t :inherit bold :height 1.15)) "Main header.") (defface naviel-separator-face '((t :inherit shadow)) "Separator lines.") (defface naviel-artist-face '((t :inherit font-lock-function-name-face :weight semi-bold)) "Artist names.") (defface naviel-album-face '((t :inherit font-lock-string-face)) "Album names.") (defface naviel-song-title-face '((t :inherit default)) "Song titles.") (defface naviel-song-meta-face '((t :inherit shadow)) "Song metadata.") (defface naviel-track-num-face '((t :inherit shadow)) "Track numbers.") (defface naviel-year-face '((t :inherit shadow)) "Album years.") (defface naviel-now-playing-face '((t :inherit success :weight bold)) "Now-playing text.") (defface naviel-paused-face '((t :inherit warning :weight bold)) "Paused indicator.") (defface naviel-footer-face '((t :inherit shadow :height 0.85)) "Footer hints.") (defface naviel-count-face '((t :inherit shadow)) "Item counts.") (defface naviel-breadcrumb-face '((t :inherit font-lock-comment-face)) "Breadcrumb trail.") (defface naviel-repeat-face '((t :inherit font-lock-keyword-face)) "Repeat mode.") (defface naviel-error-face '((t :inherit error)) "In-buffer errors.") (defface naviel-position-face '((t :inherit shadow)) "Playback position.") ;;; Repeat mode (defvar naviel-repeat-mode 'off "Playback repeat mode: \\='off, \\='one, or \\='album.") (defun naviel-toggle-repeat () "Cycle repeat mode: off → one → album → off." (interactive) (setq naviel-repeat-mode (pcase naviel-repeat-mode ('off 'one) ('one 'album) (_ 'off))) (naviel--refresh-footer) (message "Repeat: %s" (naviel--repeat-label))) (defun naviel--repeat-label () (pcase naviel-repeat-mode ('one "one") ('album "all") (_ "off"))) ;;; Internal state ;; mpv process and IPC (defvar naviel--process nil "The mpv OS process.") (defvar naviel--ipc-process nil "Persistent mpv IPC network process.") (defvar naviel--ipc-buffer "" "Accumulated un-parsed IPC bytes.") (defvar naviel--ipc-request-id 0 "Monotonically increasing request id.") (defvar naviel--ipc-callbacks nil "Alist of (id . callback) for pending IPC requests.") (defvar naviel--position-timer nil "Timer that polls mpv for time-pos.") (defvar naviel--elapsed nil "Elapsed seconds (float or nil).") (defvar naviel--duration nil "Track duration in seconds (float or nil).") ;; Queue / playback (defvar naviel--queue '() "Current play queue — list of song plists.") (defvar naviel--queue-index 0 "Index of the currently playing track.") (defvar naviel--volume 80 "Current volume 0-100.") (defvar naviel--paused nil "Non-nil when paused.") (defvar naviel--current-song nil "Plist of the currently playing song.") ;; Browser (defvar naviel--browser-stack '() "Navigation stack; each entry is a plist.") (defvar naviel--current-view nil "Plist describing the rendered view.") ;; Mode line (defvar naviel--mode-line-timer nil "Timer for mode-line refreshes.") ;;; Authentication (defun naviel--credentials () "Return (USER . PASS) from customisation variables or ~/.authinfo." (let* ((host (url-host (url-generic-parse-url naviel-url))) (user (or naviel-username (plist-get (car (auth-source-search :host host :require '(:user))) :user))) (pass (or naviel-password (let* ((entry (car (auth-source-search :host host :require '(:secret)))) (s (plist-get entry :secret))) (when s (if (functionp s) (funcall s) s)))))) (unless (and user pass) (error "naviel: no credentials for %s — set naviel-username/naviel-password or use ~/.authinfo" host)) (cons user pass))) (defun naviel--auth-params () "Return alist of Subsonic token-auth query parameters." (let* ((creds (naviel--credentials)) (salt (naviel--random-salt 10)) (token (md5 (concat (cdr creds) salt)))) `(("u" . ,(car creds)) ("t" . ,token) ("s" . ,salt) ("v" . ,naviel-api-version) ("c" . ,naviel-client-name) ("f" . "xml")))) (defun naviel--random-salt (len) (let ((chars "abcdefghijklmnopqrstuvwxyz0123456789") (r "")) (dotimes (_ len r) (setq r (concat r (string (aref chars (random (length chars))))))))) ;;; Async HTTP / API ;; ;; Every API call is non-blocking. CALLBACK is called with the parsed ;; result on success, or nil on any error (an in-buffer message is shown). (defun naviel--build-url (endpoint params) (let* ((all (append (naviel--auth-params) params)) (q (mapconcat (lambda (p) (concat (url-hexify-string (car p)) "=" (url-hexify-string (cdr p)))) all "&"))) (format "%s/rest/%s?%s" naviel-url endpoint q))) (defun naviel--request-async (endpoint params parse-fn callback) "GET ENDPOINT asynchronously. Call (CALLBACK (PARSE-FN xml)) on success." (let ((url (naviel--build-url endpoint params))) (url-retrieve url (lambda (status) (if (plist-get status :error) (progn (ignore-errors (kill-buffer (current-buffer))) (naviel--show-error (format "Could not reach %s — is the server running?" naviel-url)) (funcall callback nil)) (condition-case err (progn (goto-char (point-min)) (re-search-forward "\r?\n\r?\n" nil t) (let* ((xml (xml-parse-region (point) (point-max))) (response (naviel--check-status xml)) (result (funcall parse-fn response))) (kill-buffer (current-buffer)) (funcall callback result))) (error (ignore-errors (kill-buffer (current-buffer))) (naviel--show-error (error-message-string err)) (funcall callback nil))))) nil t))) (defun naviel--check-status (xml) (let* ((root (car xml)) (response (if (eq (xml-node-name root) 'subsonic-response) root (car (xml-get-children root 'subsonic-response)))) (status (xml-get-attribute-or-nil response 'status))) (unless response (error "naviel: unexpected XML response structure")) (when (string= status "failed") (let* ((err (car (xml-get-children response 'error))) (code (xml-get-attribute err 'code)) (msg (xml-get-attribute err 'message))) (error "naviel API error %s: %s" code msg))) response)) (defun naviel--get-child (r tag) (car (xml-get-children r tag))) (defun naviel--attr (node attr) (xml-get-attribute node attr)) ;;; Error display (defun naviel--show-error (msg) "Display MSG as a friendly in-buffer error (no raw Lisp tracebacks)." (with-current-buffer (naviel--browser-buffer) (naviel-browser-mode) (let ((inhibit-read-only t)) (erase-buffer) (insert (propertize "\n ✗ naviel error\n\n" 'face 'naviel-error-face)) (insert (propertize (format " %s\n\n" msg) 'face 'naviel-error-face)) (insert (propertize " Press g to retry, q to quit.\n" 'face 'naviel-footer-face)) (goto-char (point-min)))) (pop-to-buffer (naviel--browser-buffer))) ;;; Stream URL (defun naviel--stream-url (song-id) (naviel--build-url "stream" `(("id" . ,song-id)))) ;;; mpv IPC ;; ;; naviel--ipc-process is a Unix socket client kept alive for the ;; lifetime of a track. Its filter accumulates newline-delimited JSON ;; from mpv and dispatches each complete line to naviel--ipc-dispatch. ;; ;; Outgoing commands use naviel--ipc-send, which optionally registers a ;; one-shot callback keyed by request_id so callers can receive results. ;; ;; mpv also emits unsolicited "event" objects; naviel--ipc-handle-event ;; handles the ones we care about (end-file, pause, unpause). (defun naviel--ipc-socket-path () (expand-file-name "naviel-mpv.sock" temporary-file-directory)) (defun naviel--ipc-connect () "Open a persistent connection to the mpv IPC socket." (let ((sock (naviel--ipc-socket-path)) (limit (+ (float-time) 1.5))) (while (and (not (file-exists-p sock)) (< (float-time) limit)) (sleep-for 0.05)) (when (file-exists-p sock) (condition-case err (setq naviel--ipc-process (make-network-process :name "naviel-ipc" :family 'local :service sock :filter #'naviel--ipc-filter :sentinel #'naviel--ipc-sentinel :coding 'utf-8-unix) naviel--ipc-buffer "") (error (message "naviel: IPC connect failed — %s" (error-message-string err))))))) (defun naviel--ipc-filter (_proc string) "Accumulate STRING and dispatch complete JSON lines." (setq naviel--ipc-buffer (concat naviel--ipc-buffer string)) (let ((start 0)) (while (string-match "\n" naviel--ipc-buffer start) (let* ((end (match-end 0)) (line (substring naviel--ipc-buffer start (1- end)))) (setq start end) (naviel--ipc-dispatch line))) (setq naviel--ipc-buffer (substring naviel--ipc-buffer start)))) (defun naviel--ipc-sentinel (proc event) (when (and (string-match-p "deleted\\|closed\\|failed" event) (eq proc naviel--ipc-process)) (setq naviel--ipc-process nil))) (defun naviel--ipc-dispatch (json-line) "Parse one JSON LINE from mpv and act on it." (condition-case nil (let* ((obj (json-read-from-string json-line)) (event (cdr (assq 'event obj))) (req-id (cdr (assq 'request_id obj))) (data (cdr (assq 'data obj))) (err (cdr (assq 'error obj)))) ;; One-shot request callbacks. (when req-id (let ((cb (cdr (assq req-id naviel--ipc-callbacks)))) (when cb (setq naviel--ipc-callbacks (assq-delete-all req-id naviel--ipc-callbacks)) (when (or (null err) (string= err "success")) (funcall cb data))))) ;; Unsolicited events. (when event (naviel--ipc-handle-event event))) (error nil))) (defun naviel--ipc-handle-event (event) "Dispatch mpv EVENT string to the appropriate handler." (cond ((string= event "end-file") (naviel--next-in-queue)) ((string= event "pause") (setq naviel--paused t) (naviel--refresh-footer)) ((string= event "unpause") (setq naviel--paused nil) (naviel--refresh-footer)))) (defun naviel--ipc-send (command &optional callback) "Send COMMAND list to mpv IPC. Call CALLBACK with the data field if provided." (when (and naviel--ipc-process (process-live-p naviel--ipc-process)) (cl-incf naviel--ipc-request-id) (let* ((id naviel--ipc-request-id) (msg (append `(("command" . ,(vconcat command))) (when callback `(("request_id" . ,id))))) (json (concat (json-encode msg) "\n"))) (when callback (push (cons id callback) naviel--ipc-callbacks)) (condition-case err (process-send-string naviel--ipc-process json) (error (message "naviel IPC send: %s" (error-message-string err))))))) ;;; Playback position polling (defun naviel--start-position-timer () (naviel--stop-position-timer) (setq naviel--position-timer (run-with-timer naviel-position-poll-interval naviel-position-poll-interval #'naviel--poll-position))) (defun naviel--stop-position-timer () (when naviel--position-timer (cancel-timer naviel--position-timer) (setq naviel--position-timer nil))) (defun naviel--poll-position () "Ask mpv for time-pos and duration; update state and refresh footer." (when (and naviel--ipc-process (process-live-p naviel--ipc-process)) (naviel--ipc-send '("get_property" "time-pos") (lambda (v) (setq naviel--elapsed (and (numberp v) v)) (naviel--refresh-footer))) (naviel--ipc-send '("get_property" "duration") (lambda (v) (setq naviel--duration (and (numberp v) v)))))) ;;; mpv process management (defun naviel--stop () "Stop playback and tear down all mpv-related state." (naviel--stop-position-timer) (when (and naviel--ipc-process (process-live-p naviel--ipc-process)) (delete-process naviel--ipc-process)) (setq naviel--ipc-process nil naviel--ipc-buffer "") (when (and naviel--process (process-live-p naviel--process)) (delete-process naviel--process)) (let ((sock (naviel--ipc-socket-path))) (when (file-exists-p sock) (ignore-errors (delete-file sock)))) (setq naviel--process nil naviel--paused nil naviel--current-song nil naviel--elapsed nil naviel--duration nil) (naviel--refresh-footer)) (defun naviel--play-url (url song-info) "Launch mpv on URL and track SONG-INFO as the current song." (naviel--stop) (setq naviel--current-song song-info naviel--paused nil naviel--elapsed nil naviel--duration nil) (let* ((sock (naviel--ipc-socket-path)) (proc (start-process "naviel-mpv" nil naviel-mpv-executable "--no-video" "--quiet" (format "--volume=%d" naviel--volume) (format "--input-ipc-server=%s" sock) url))) (setq naviel--process proc)) ;; Connect IPC after a brief delay for mpv to initialise. (run-with-timer 0.3 nil #'naviel--ipc-connect) (run-with-timer 0.6 nil #'naviel--start-position-timer) (naviel--refresh-footer) (message "♪ %s — %s" (plist-get song-info :title) (plist-get song-info :artist))) (defun naviel--toggle-pause () "Toggle pause/resume via IPC — no restart." (interactive) (if (and naviel--process (process-live-p naviel--process)) (naviel--ipc-send '("cycle" "pause")) (message "naviel: nothing is playing"))) (defun naviel--seek (seconds) "Seek SECONDS relative to the current position." (if (and naviel--process (process-live-p naviel--process)) (naviel--ipc-send `("seek" ,seconds "relative")) (message "naviel: nothing is playing"))) (defun naviel-seek-forward () "Seek forward." (interactive) (naviel--seek naviel-seek-step)) (defun naviel-seek-backward () "Seek backward." (interactive) (naviel--seek (- naviel-seek-step))) ;;; Queue management (defun naviel--play-queue-index (idx) (setq naviel--queue-index idx) (let* ((song (nth idx naviel--queue)) (url (naviel--stream-url (plist-get song :id)))) (naviel--play-url url song) (naviel--rerender-current-view))) (defun naviel--next-in-queue () "Advance to the next track, obeying repeat mode." (interactive) (pcase naviel-repeat-mode ('one (naviel--play-queue-index naviel--queue-index)) ('album (naviel--play-queue-index (mod (1+ naviel--queue-index) (max 1 (length naviel--queue))))) (_ (let ((next (1+ naviel--queue-index))) (if (< next (length naviel--queue)) (naviel--play-queue-index next) (naviel--stop) (message "naviel: end of queue")))))) (defun naviel--prev-in-queue () (interactive) (let ((prev (1- naviel--queue-index))) (if (>= prev 0) (naviel--play-queue-index prev) (message "naviel: at start of queue")))) (defun naviel--volume-up () (interactive) (setq naviel--volume (min 100 (+ naviel--volume naviel-volume-step))) (naviel--ipc-send `("set_property" "volume" ,naviel--volume)) (naviel--refresh-footer) (message "Volume: %d%%" naviel--volume)) (defun naviel--volume-down () (interactive) (setq naviel--volume (max 0 (- naviel--volume naviel-volume-step))) (naviel--ipc-send `("set_property" "volume" ,naviel--volume)) (naviel--refresh-footer) (message "Volume: %d%%" naviel--volume)) ;;; API parse helpers (defun naviel--parse-artists (response) (let (result) (dolist (index (xml-get-children (naviel--get-child response 'artists) 'index) result) (dolist (a (xml-get-children index 'artist)) (push `(:id ,(naviel--attr a 'id) :name ,(naviel--attr a 'name) :albums ,(naviel--attr a 'albumCount)) result))) (nreverse result))) (defun naviel--parse-artist-albums (response) (let (result) (dolist (al (xml-get-children (naviel--get-child response 'artist) 'album) result) (push `(:id ,(naviel--attr al 'id) :name ,(naviel--attr al 'name) :year ,(naviel--attr al 'year)) result)) (nreverse result))) (defun naviel--parse-album-songs (response) (let (result) (dolist (s (xml-get-children (naviel--get-child response 'album) 'song) result) (push `(:id ,(naviel--attr s 'id) :title ,(naviel--attr s 'title) :artist ,(naviel--attr s 'artist) :album ,(naviel--attr s 'album) :track ,(naviel--attr s 'track) :duration ,(naviel--attr s 'duration)) result)) (nreverse result))) (defun naviel--parse-search (response) (let* ((r3 (naviel--get-child response 'searchResult3)) artists albums songs) (dolist (a (xml-get-children r3 'artist)) (push `(:id ,(naviel--attr a 'id) :name ,(naviel--attr a 'name)) artists)) (dolist (al (xml-get-children r3 'album)) (push `(:id ,(naviel--attr al 'id) :name ,(naviel--attr al 'name) :artist ,(naviel--attr al 'artist)) albums)) (dolist (s (xml-get-children r3 'song)) (push `(:id ,(naviel--attr s 'id) :title ,(naviel--attr s 'title) :artist ,(naviel--attr s 'artist) :album ,(naviel--attr s 'album) :duration ,(naviel--attr s 'duration)) songs)) `(:artists ,(nreverse artists) :albums ,(nreverse albums) :songs ,(nreverse songs)))) (defun naviel--parse-random-songs (response) (let (result) (dolist (s (xml-get-children (naviel--get-child response 'randomSongs) 'song) result) (push `(:id ,(naviel--attr s 'id) :title ,(naviel--attr s 'title) :artist ,(naviel--attr s 'artist) :album ,(naviel--attr s 'album) :duration ,(naviel--attr s 'duration)) result)) (nreverse result))) ;;; Async API entry points (defun naviel--get-artists (cb) (naviel--request-async "getArtists" '() #'naviel--parse-artists cb)) (defun naviel--get-artist (id cb) (naviel--request-async "getArtist" `(("id" . ,id)) #'naviel--parse-artist-albums cb)) (defun naviel--get-album (id cb) (naviel--request-async "getAlbum" `(("id" . ,id)) #'naviel--parse-album-songs cb)) (defun naviel--search-async (q cb) (naviel--request-async "search3" `(("query" . ,q) ("artistCount" . "10") ("albumCount" . "10") ("songCount" . "20")) #'naviel--parse-search cb)) (defun naviel--get-random-songs (n cb) (naviel--request-async "getRandomSongs" `(("size" . ,(number-to-string n))) #'naviel--parse-random-songs cb)) ;;; Duration / string helpers (defun naviel--format-secs (secs) "Format SECS (number or nil) as M:SS string." (if (and secs (numberp secs) (> secs 0)) (let* ((s (round secs)) (m (/ s 60)) (ss (% s 60))) (format "%d:%02d" m ss)) "--:--")) (defun naviel--trunc (s max) "Truncate string S to MAX chars, appending … if needed." (if (and s (> (length s) max)) (concat (substring s 0 (- max 1)) "…") (or s ""))) ;;; Browser buffer (defun naviel--browser-buffer () (get-buffer-create "*Naviel*")) (defun naviel--make-breadcrumbs () (if (null naviel--browser-stack) "" (propertize (concat " " (mapconcat (lambda (v) (plist-get v :label)) (reverse naviel--browser-stack) " › ") "\n") 'face 'naviel-breadcrumb-face))) (defun naviel--volume-bar (vol) (let* ((w 10) (f (round (* w (/ vol 100.0))))) (concat "[" (make-string f ?█) (make-string (- w f) ?░) (format "] %3d%%" vol)))) (defun naviel--now-playing-bar () "Build the persistent footer string." (let* ((song naviel--current-song) (elap (naviel--format-secs naviel--elapsed)) (dur (naviel--format-secs (or naviel--duration (when song (let ((d (plist-get song :duration))) (when (and d (not (string= d ""))) (string-to-number d))))))) (qlen (length naviel--queue))) (concat "\n" (propertize (make-string (max 40 (- (window-width) 2)) ?─) 'face 'naviel-separator-face) "\n" (if song (format " %s%s%s%s\n" (if naviel--paused (propertize "⏸ " 'face 'naviel-paused-face) (propertize "▶ " 'face 'naviel-now-playing-face)) (propertize (naviel--trunc (plist-get song :title) 35) 'face 'naviel-now-playing-face) (propertize (concat " — " (naviel--trunc (plist-get song :artist) 25)) 'face 'naviel-song-meta-face) (propertize (format " %s / %s [%d/%d]" elap dur (1+ naviel--queue-index) qlen) 'face 'naviel-position-face)) (propertize " ♪ Nothing playing\n" 'face 'shadow)) (format " %s repeat: %s\n" (propertize (format "vol %s" (naviel--volume-bar naviel--volume)) 'face 'naviel-song-meta-face) (propertize (naviel--repeat-label) 'face 'naviel-repeat-face)) (propertize " RET play SPC pause n/p skip [ ] seek +/- vol s search r random b back R repeat ? help" 'face 'naviel-footer-face) "\n"))) (defconst naviel--footer-sep "\0naviel-footer\0" "Invisible marker separating body from footer in the browser buffer.") ;;; Core render (defun naviel--browser-render (heading items format-fn type &optional section-label) "Render the browser buffer and store view state." (setq naviel--current-view `(:type ,type :items ,items :heading ,heading :format-fn ,format-fn :section-label ,section-label)) (naviel--do-render heading items format-fn type section-label)) (defun naviel--do-render (heading items format-fn type section-label) (with-current-buffer (naviel--browser-buffer) (naviel-browser-mode) (let ((inhibit-read-only t) (saved-line (line-number-at-pos))) (erase-buffer) ;; Header (insert (naviel--make-breadcrumbs)) (insert (propertize (format " ♪ %s\n" heading) 'face 'naviel-header-face)) (insert (propertize (make-string (min 72 (window-width)) ?═) 'face 'naviel-separator-face)) (insert "\n") (when section-label (insert (propertize (format "\n %s\n\n" section-label) 'face 'naviel-breadcrumb-face))) ;; Body (if (null items) (insert (propertize " (no results)\n" 'face 'shadow)) (let ((idx 0)) (dolist (item items) (let* ((is-playing (and naviel--current-song (eq type 'song) (= idx naviel--queue-index) (equal (plist-get item :id) (plist-get naviel--current-song :id)))) (line (funcall format-fn item is-playing))) (insert (propertize line 'naviel-item item 'naviel-type type 'naviel-idx idx 'face (when is-playing 'naviel-now-playing-face))) (insert "\n")) (cl-incf idx)))) ;; Footer (insert (propertize naviel--footer-sep 'invisible t)) (insert (naviel--now-playing-bar)) ;; Restore cursor position (goto-char (point-min)) (forward-line (max 0 (- saved-line 1)))))) (defun naviel--rerender-current-view () (when (and naviel--current-view (get-buffer "*Naviel*")) (naviel--do-render (plist-get naviel--current-view :heading) (plist-get naviel--current-view :items) (plist-get naviel--current-view :format-fn) (plist-get naviel--current-view :type) (plist-get naviel--current-view :section-label)))) (defun naviel--refresh-footer () (naviel--rerender-current-view) (naviel--update-mode-line)) ;;; Format callbacks (defun naviel--format-artist (artist _p) (format " %s%s" (propertize (naviel--trunc (plist-get artist :name) 52) 'face 'naviel-artist-face) (let ((n (plist-get artist :albums))) (if (and n (not (string= n ""))) (propertize (format " (%s)" n) 'face 'naviel-count-face) "")))) (defun naviel--format-album (album _p) (format " %s%s" (propertize (naviel--trunc (plist-get album :name) 52) 'face 'naviel-album-face) (let ((y (plist-get album :year))) (if (and y (not (string= y ""))) (propertize (format " %s" y) 'face 'naviel-year-face) "")))) (defun naviel--format-song (song playing) (let* ((track (or (plist-get song :track) "")) (title (naviel--trunc (or (plist-get song :title) "?") 36)) (artist (naviel--trunc (or (plist-get song :artist) "") 26)) (dur (naviel--format-secs (let ((d (plist-get song :duration))) (when (and d (not (string= d ""))) (string-to-number d)))))) (format "%s%s %-36s %-26s %s" (if playing (propertize "▶ " 'face 'naviel-now-playing-face) " ") (propertize (format "%3s." track) 'face 'naviel-track-num-face) (propertize title 'face (if playing 'naviel-now-playing-face 'naviel-song-title-face)) (propertize artist 'face 'naviel-song-meta-face) (propertize dur 'face 'naviel-song-meta-face)))) ;;; Render entry points (defun naviel--render-artists (artists) (naviel--browser-render (format "Artists (%d)" (length artists)) artists #'naviel--format-artist 'artist)) (defun naviel--render-albums (albums name) (naviel--browser-render name albums #'naviel--format-album 'album (format "%d album%s" (length albums) (if (= 1 (length albums)) "" "s")))) (defun naviel--render-songs (songs context &optional section) (naviel--browser-render context songs #'naviel--format-song 'song (or section (format "%d track%s" (length songs) (if (= 1 (length songs)) "" "s"))))) ;;; Browser mode (defvar naviel-browser-mode-map (let ((m (make-sparse-keymap))) (define-key m (kbd "RET") #'naviel--browser-enter) (define-key m (kbd "SPC") #'naviel--toggle-pause) (define-key m (kbd "n") #'naviel--next-in-queue) (define-key m (kbd "p") #'naviel--prev-in-queue) (define-key m (kbd "+") #'naviel--volume-up) (define-key m (kbd "=") #'naviel--volume-up) (define-key m (kbd "-") #'naviel--volume-down) (define-key m (kbd "[") #'naviel-seek-backward) (define-key m (kbd "]") #'naviel-seek-forward) (define-key m (kbd "s") #'naviel-search) (define-key m (kbd "r") #'naviel-play-random) (define-key m (kbd "b") #'naviel--browser-back) (define-key m (kbd "g") #'naviel--browser-refresh) (define-key m (kbd "q") #'naviel--browser-quit) (define-key m (kbd "?") #'naviel-help) (define-key m (kbd "R") #'naviel-toggle-repeat) m)) (define-derived-mode naviel-browser-mode special-mode "Naviel" "Major mode for browsing and controlling Naviel playback." (setq buffer-read-only t) (setq-local revert-buffer-function #'naviel--browser-refresh) (hl-line-mode 1)) (defun naviel--item-at-point () (let ((type (get-text-property (point) 'naviel-type)) (item (get-text-property (point) 'naviel-item))) (when type (cons type item)))) (defun naviel--browser-enter () "Act on the item at point." (interactive) (let ((entry (naviel--item-at-point))) (unless entry (user-error "No item at point")) (let ((type (car entry)) (item (cdr entry))) (pcase type ('artist (let ((id (plist-get item :id)) (name (plist-get item :name))) (push `(:type artist :data ,id :label ,name) naviel--browser-stack) (message "naviel: loading albums…") (naviel--get-artist id (lambda (albums) (if albums (naviel--render-albums albums name) (pop naviel--browser-stack)))))) ('album (let ((id (plist-get item :id)) (name (plist-get item :name))) (push `(:type album :data ,id :label ,name) naviel--browser-stack) (message "naviel: loading tracks…") (naviel--get-album id (lambda (songs) (if songs (progn (setq naviel--queue songs naviel--queue-index 0) (naviel--render-songs songs name)) (pop naviel--browser-stack)))))) ('song (naviel--play-queue-index (get-text-property (point) 'naviel-idx))) (_ (message "naviel: unknown type: %s" type)))))) (defun naviel--browser-back () "Navigate back one level in the browser." (interactive) (cond ((null naviel--browser-stack) (message "naviel: already at top level")) ((= 1 (length naviel--browser-stack)) (setq naviel--browser-stack '()) (naviel--show-artists)) (t (pop naviel--browser-stack) (let* ((frame (car naviel--browser-stack)) (id (plist-get frame :data)) (name (plist-get frame :label))) (naviel--get-artist id (lambda (albums) (when albums (naviel--render-albums albums name)))))))) (defun naviel--browser-refresh (&rest _) "Reload current view from the server." (interactive) (if (null naviel--browser-stack) (naviel--show-artists) (let* ((frame (car naviel--browser-stack)) (type (plist-get frame :type)) (id (plist-get frame :data)) (name (plist-get frame :label))) (pcase type ('artist (naviel--get-artist id (lambda (a) (when a (naviel--render-albums a name))))) ('album (naviel--get-album id (lambda (s) (when s (naviel--render-songs s name))))) (_ (naviel--show-artists)))))) (defun naviel--browser-quit () (interactive) (quit-window)) (defun naviel--show-artists () (message "naviel: loading library…") (naviel--get-artists (lambda (artists) (when artists (setq naviel--browser-stack '()) (naviel--render-artists artists))))) ;;; Mode line (defun naviel--mode-line-string () (if naviel--current-song (format " ♪%s %s%s" (if naviel--paused "⏸" "▶") (naviel--trunc (plist-get naviel--current-song :title) 28) (if (and naviel--elapsed naviel--duration) (format " %s/%s" (naviel--format-secs naviel--elapsed) (naviel--format-secs naviel--duration)) "")) "")) (defun naviel--update-mode-line () (force-mode-line-update t)) ;;; Public commands ;;;###autoload (defun naviel () "Open the Naviel music browser." (interactive) (unless (executable-find naviel-mpv-executable) (error "naviel: mpv not found on PATH")) (pop-to-buffer (naviel--browser-buffer)) (naviel--show-artists)) ;;;###autoload (defun naviel-search (query) "Search Naviel for QUERY, displaying artists, albums, and songs." (interactive "sSearch Naviel: ") (when (string= query "") (user-error "Search query cannot be empty")) (message "naviel: searching for \"%s\"…" query) (naviel--search-async query (lambda (results) (when results (let ((artists (plist-get results :artists)) (albums (plist-get results :albums)) (songs (plist-get results :songs))) (pop-to-buffer (naviel--browser-buffer)) (naviel-browser-mode) (let ((inhibit-read-only t)) (erase-buffer) (insert (propertize (format " ♪ Search: %s\n" query) 'face 'naviel-header-face)) (insert (propertize (make-string (min 72 (window-width)) ?═) 'face 'naviel-separator-face)) (insert "\n") (cl-flet ((section (label items type fmt-fn) (when items (insert (propertize (format "\n %s\n" label) 'face 'naviel-breadcrumb-face)) (let ((idx 0)) (dolist (item items) (insert (propertize (funcall fmt-fn item nil) 'naviel-item item 'naviel-type type 'naviel-idx idx)) (insert "\n") (cl-incf idx)))))) (section "Artists" artists 'artist #'naviel--format-artist) (section "Albums" albums 'album #'naviel--format-album) (when songs (insert (propertize "\n Songs\n" 'face 'naviel-breadcrumb-face)) (setq naviel--queue songs naviel--queue-index 0) (let ((idx 0)) (dolist (s songs) (insert (propertize (naviel--format-song s (and naviel--current-song (equal (plist-get s :id) (plist-get naviel--current-song :id)))) 'naviel-item s 'naviel-type 'song 'naviel-idx idx)) (insert "\n") (cl-incf idx))) (message "naviel: %d song%s in queue" (length songs) (if (= 1 (length songs)) "" "s"))) (when (and (null artists) (null albums) (null songs)) (insert (propertize " No results found.\n" 'face 'shadow)))) (insert (propertize naviel--footer-sep 'invisible t)) (insert (naviel--now-playing-bar)) (goto-char (point-min)) (forward-line 3))))))) ;;;###autoload (defun naviel-play-random (&optional count) "Play COUNT (default 20) random songs." (interactive "P") (let ((n (if count (prefix-numeric-value count) 20))) (message "naviel: fetching %d random tracks…" n) (naviel--get-random-songs n (lambda (songs) (when songs (setq naviel--queue songs naviel--queue-index 0) (pop-to-buffer (naviel--browser-buffer)) (naviel--render-songs songs (format "Random — %d tracks" n)) (naviel--play-queue-index 0)))))) ;;;###autoload (defun naviel-stop () "Stop playback." (interactive) (naviel--stop) (message "naviel: stopped")) ;;;###autoload (defun naviel-help () "Show naviel keybinding help." (interactive) (with-help-window "*Naviel Help*" (princ "Naviel — Navidrome client for Emacs (v0.3 / Phase 1)\n") (princ (make-string 52 ?─)) (princ "\n\n") (princ "Navigation\n") (princ " RET Play item / expand artist or album\n") (princ " b Go back one level\n") (princ " g Refresh current view from server\n") (princ " s Search library\n") (princ " r Play random (C-u r for custom count)\n") (princ " q Quit browser\n\n") (princ "Playback\n") (princ " SPC Toggle pause / resume\n") (princ " n Next track\n") (princ " p Previous track\n") (princ " [ Seek backward (naviel-seek-step seconds)\n") (princ " ] Seek forward (naviel-seek-step seconds)\n") (princ " + = Volume up\n") (princ " - Volume down\n") (princ " R Cycle repeat: off → one → all → off\n\n") (princ "Customisation\n") (princ " naviel-seek-step seconds per seek (default 10)\n") (princ " naviel-volume-step % per +/- press (default 5)\n") (princ " naviel-position-poll-interval IPC poll rate in s (default 1.0)\n"))) ;;; Mode line integration (defvar naviel-mode-line-format '(:eval (naviel--mode-line-string))) ;;;###autoload (define-minor-mode naviel-mode-line-mode "Show Naviel playback status in the mode line." :global t :lighter nil (if naviel-mode-line-mode (progn (add-to-list 'global-mode-string naviel-mode-line-format) (setq naviel--mode-line-timer (run-with-timer 1 1 #'naviel--update-mode-line))) (setq global-mode-string (remove naviel-mode-line-format global-mode-string)) (when naviel--mode-line-timer (cancel-timer naviel--mode-line-timer) (setq naviel--mode-line-timer nil)))) (provide 'naviel) ;;; naviel.el ends here