From 034ee0e21c3943f4b4c5c0ce05d2a41cb6999f43 Mon Sep 17 00:00:00 2001 From: David Moc Date: Fri, 3 Apr 2026 23:36:53 +0200 Subject: Only God knows how. --- naviel.el | 930 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 930 insertions(+) create mode 100755 naviel.el (limited to 'naviel.el') diff --git a/naviel.el b/naviel.el new file mode 100755 index 0000000..9c832b9 --- /dev/null +++ b/naviel.el @@ -0,0 +1,930 @@ +;;; 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 -- cgit v1.2.3