aboutsummaryrefslogtreecommitdiff
path: root/elisp/emms-info-native.el
diff options
context:
space:
mode:
authorbard <[email protected]>2023-10-08 15:17:31 -0400
committerbard <[email protected]>2023-10-08 15:17:31 -0400
commita2ec9082998918158df250c1906d0f6c0c4889db (patch)
tree52e42110cc407b7a142fb6216df0d4cf2f82da1c /elisp/emms-info-native.el
parent16b4c9ed8f62dccce9a3ec32810077a9140f8925 (diff)
emms package
Diffstat (limited to 'elisp/emms-info-native.el')
-rw-r--r--elisp/emms-info-native.el982
1 files changed, 982 insertions, 0 deletions
diff --git a/elisp/emms-info-native.el b/elisp/emms-info-native.el
new file mode 100644
index 0000000..15f2d4c
--- /dev/null
+++ b/elisp/emms-info-native.el
@@ -0,0 +1,982 @@
+;;; emms-info-native.el --- Native Emacs Lisp info method for EMMS -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020-2023 Free Software Foundation, Inc.
+
+;; Author: Petteri Hintsanen <[email protected]>
+
+;; This file is part of EMMS.
+
+;; EMMS is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; EMMS is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
+;; License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with EMMS; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
+;; MA 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file provides a native emms-info-method for EMMS. Here
+;; "native" means a pure Emacs Lisp implementation instead of one
+;; relying on external tools or libraries like `emms-info-ogginfo' or
+;; `emms-info-libtag'.
+;;
+;; To use this method, add `emms-info-native' to
+;; `emms-info-functions'.
+;;
+;; The following file formats are supported:
+;;
+;; - Vorbis: Ogg Vorbis I Profile, filename extension `.ogg',
+;; elementary streams only. Based on xiph.org's Vorbis I
+;; specification, see URL
+;; `https://xiph.org/vorbis/doc/Vorbis_I_spec.html'.
+;;
+;; - Opus: Ogg Opus profile, filename extension `.opus', elementary
+;; streams only. Based on RFC 7845, see URL
+;; `https://tools.ietf.org/html/rfc7845.html'.
+;;
+;; - FLAC streams in native encapsulation format, filename extension
+;; `.flac'. Based on xiph.org's FLAC format specification, see URL
+;; `https://xiph.org/flac/format.html'.
+;;
+;; - MP3 files with extension `.mp3' and id3v2 tags. All id3v2
+;; versions should work, but many features like CRC, compression and
+;; encryption are not supported. Based on id3v2 Informal Standards,
+;; see URL `https://id3.org'.
+;;
+;; - SPC files with extension `.spc' and id666 tags. This is an audio
+;; file based on a memory dump from an SPC700, a special audio chip
+;; found within Super Nintendos.
+;;
+;; Format detection is based solely on filename extension, which is
+;; matched case-insensitively.
+
+;;; Code:
+
+(require 'bindat)
+(require 'cl-lib)
+(require 'emms-info)
+(require 'emms-info-spc)
+(require 'seq)
+(require 'subr-x)
+
+(defconst emms-info-native--max-peek-size (* 2048 1024)
+ "Maximum buffer size for metadata decoding.
+Functions called by `emms-info-native' read certain amounts of
+data into a temporary buffer while decoding metadata. This
+variable controls the maximum size of that buffer: if more than
+`emms-info-native--max-peek-size' bytes are needed, an error is
+signaled.
+
+Technically metadata blocks can have almost arbitrary lengths,
+but in practice processing must be constrained to prevent memory
+exhaustion in case of garbled or malicious inputs.")
+
+(defvar emms-info-native--opus-channel-count 0
+ "Last decoded Opus channel count.
+This is a kludge; it is needed because bindat spec cannot refer
+outside itself.")
+
+(defvar emms-info-native--id3v2-version 0
+ "Last decoded id3v2 version.
+This is a kludge; it is needed because bindat spec cannot refer
+outside itself.")
+
+;;;; Vorbis code
+
+(defconst emms-info-native--max-num-vorbis-comments 1024
+ "Maximum number of Vorbis comment fields in a stream.
+Technically a single Vorbis stream may have up to 2^32 comments,
+but in practice processing must be constrained to prevent memory
+exhaustion in case of garbled or malicious inputs.
+
+This limit is used with Opus and FLAC streams as well, since
+their comments have almost the same format as Vorbis.")
+
+(defconst emms-info-native--max-vorbis-comment-size (* 64 1024)
+ "Maximum length for a single Vorbis comment field.
+Technically a single Vorbis comment may have a length up to 2^32
+bytes, but in practice processing must be constrained to prevent
+memory exhaustion in case of garbled or malicious inputs.
+
+This limit is used with Opus and FLAC streams as well, since
+their comments have almost the same format as Vorbis.")
+
+(defconst emms-info-native--max-vorbis-vendor-length 1024
+ "Maximum length of Vorbis vendor string.
+Technically a vendor string can be up to 2^32 bytes long, but in
+practice processing must be constrained to prevent memory
+exhaustion in case of garbled or malicious inputs.
+
+This limit is used with Opus and FLAC streams as well, since
+their comments have almost the same format as Vorbis.")
+
+(defconst emms-info-native--accepted-vorbis-fields
+ '("album"
+ "albumartist"
+ "albumartistsort"
+ "albumsort"
+ "artist"
+ "artistsort"
+ "composer"
+ "composersort"
+ "date"
+ "discnumber"
+ "genre"
+ "label"
+ "originaldate"
+ "originalyear"
+ "performer"
+ "title"
+ "titlesort"
+ "tracknumber"
+ "year")
+ "EMMS info fields that are extracted from Vorbis comments.")
+
+(defconst emms-info-native--vorbis-headers-bindat-spec
+ '((identification-header struct emms-info-native--vorbis-identification-header-bindat-spec)
+ (comment-header struct emms-info-native--vorbis-comment-header-bindat-spec))
+ "Specification for first two Vorbis header packets.
+They are always an identification header followed by a comment
+header.")
+
+(defconst emms-info-native--vorbis-identification-header-bindat-spec
+ '((packet-type u8)
+ (eval (unless (= last 1)
+ (error "Vorbis header type mismatch: expected 1, got %s"
+ last)))
+ (vorbis vec 6)
+ (eval (unless (equal last emms-info-native--vorbis-magic-array)
+ (error "Vorbis framing mismatch: expected `%s', got `%s'"
+ emms-info-native--vorbis-magic-array
+ last)))
+ (vorbis-version u32r)
+ (eval (unless (= last 0)
+ (error "Vorbis version mismatch: expected 0, got %s"
+ last)))
+ (audio-channels u8)
+ (audio-sample-rate u32r)
+ (bitrate-maximum u32r)
+ (bitrate-nominal u32r)
+ (bitrate-minimum u32r)
+ (blocksize u8)
+ (framing-flag u8)
+ (eval (unless (= last 1))
+ (error "Vorbis framing bit mismatch: expected 1, got %s"
+ last)))
+ "Vorbis identification header specification.")
+
+(defconst emms-info-native--vorbis-magic-array
+ [118 111 114 98 105 115]
+ "Header packet magic pattern `vorbis'.")
+
+(defconst emms-info-native--vorbis-comment-header-bindat-spec
+ '((packet-type u8)
+ (eval (unless (= last 3)
+ (error "Vorbis header type mismatch: expected 3, got %s"
+ last)))
+ (vorbis vec 6)
+ (eval (unless (equal last emms-info-native--vorbis-magic-array)
+ (error "Vorbis framing mismatch: expected `%s', got `%s'"
+ emms-info-native--vorbis-magic-array
+ last)))
+ (vendor-length u32r)
+ (eval (when (> last emms-info-native--max-vorbis-vendor-length)
+ (error "Vorbis vendor length %s is too long" last)))
+ (vendor-string vec (vendor-length))
+ (user-comments-list-length u32r)
+ (eval (when (> last emms-info-native--max-num-vorbis-comments)
+ (error "Vorbis user comment list length %s is too long"
+ last)))
+ (user-comments repeat
+ (user-comments-list-length)
+ (struct emms-info-native--vorbis-comment-field-bindat-spec))
+ (framing-bit u8)
+ (eval (unless (= last 1))
+ (error "Vorbis framing bit mismatch: expected 1, got %s"
+ last)))
+ "Vorbis comment header specification.")
+
+(defconst emms-info-native--vorbis-comment-field-bindat-spec
+ '((length u32r)
+ (eval (when (> last emms-info-native--max-vorbis-comment-size)
+ (error "Vorbis comment length %s is too long" last)))
+ (user-comment vec (length)))
+ "Vorbis comment field specification.")
+
+(defun emms-info-native--extract-vorbis-comments (user-comments)
+ "Return a decoded list of comments from USER-COMMENTS.
+USER-COMMENTS should be a list of Vorbis comments according to
+`user-comments' field in
+`emms-info-native--vorbis-comment-header-bindat-spec',
+`emms-info-native--opus-comment-header-bindat-spec' or
+`emms-info-native--flac-comment-block-bindat-spec'.
+
+Return comments in a list of (FIELD . VALUE) cons cells. Only
+FIELDs that are listed in
+`emms-info-native--accepted-vorbis-fields' are returned."
+ (let (comments)
+ (dolist (user-comment user-comments)
+ (let* ((comment (cdr (assoc 'user-comment user-comment)))
+ (pair (emms-info-native--split-vorbis-comment comment)))
+ (push pair comments)))
+ (seq-filter (lambda (elt)
+ (member (car elt)
+ emms-info-native--accepted-vorbis-fields))
+ comments)))
+
+(defun emms-info-native--split-vorbis-comment (comment)
+ "Split Vorbis comment to a field-value pair.
+Vorbis comments are of form `FIELD=VALUE'. FIELD is a
+case-insensitive field name with a restricted set of ASCII
+characters. VALUE is an arbitrary UTF-8 encoded octet stream.
+
+Return a cons cell (FIELD . VALUE), where FIELD is converted to
+lower case and VALUE is the decoded value."
+ (let ((comment-string (decode-coding-string (mapconcat
+ #'byte-to-string
+ comment
+ nil)
+ 'utf-8)))
+ (when (string-match "^\\(.+?\\)=\\(.+?\\)$" comment-string)
+ (cons (downcase (match-string 1 comment-string))
+ (match-string 2 comment-string)))))
+
+;;;; Opus code
+
+(defconst emms-info-native--opus-headers-bindat-spec
+ '((identification-header struct emms-info-native--opus-identification-header-bindat-spec)
+ (comment-header struct emms-info-native--opus-comment-header-bindat-spec))
+ "Specification for two first Opus header packets.
+They are always an identification header followed by a comment
+header.")
+
+(defconst emms-info-native--opus-identification-header-bindat-spec
+ '((opus-head vec 8)
+ (eval (unless (equal last emms-info-native--opus-head-magic-array)
+ (error "Opus framing mismatch: expected `%s', got `%s'"
+ emms-info-native--opus-head-magic-array
+ last)))
+ (opus-version u8)
+ (eval (unless (< last 16)
+ (error "Opus version mismatch: expected < 16, got %s"
+ last)))
+ (channel-count u8)
+ (eval (setq emms-info-native--opus-channel-count last))
+ (pre-skip u16r)
+ (sample-rate u32r)
+ (output-gain u16r)
+ (channel-mapping-family u8)
+ (union (channel-mapping-family)
+ (0 nil)
+ (t (struct emms-info-native--opus-channel-mapping-table))))
+ "Opus identification header specification.")
+
+(defconst emms-info-native--opus-head-magic-array
+ [79 112 117 115 72 101 97 100]
+ "Opus identification header magic pattern `OpusHead'.")
+
+(defconst emms-info-native--opus-channel-mapping-table
+ '((stream-count u8)
+ (coupled-count u8)
+ (channel-mapping vec (eval emms-info-native--opus-channel-count)))
+ "Opus channel mapping table specification.")
+
+(defconst emms-info-native--opus-comment-header-bindat-spec
+ '((opus-tags vec 8)
+ (eval (unless (equal last emms-info-native--opus-tags-magic-array)
+ (error "Opus framing mismatch: expected `%s', got `%s'"
+ emms-info-native--opus-tags-magic-array
+ last)))
+ (vendor-length u32r)
+ (eval (when (> last emms-info-native--max-vorbis-vendor-length)
+ (error "Opus vendor length %s is too long" last)))
+ (vendor-string vec (vendor-length))
+ (user-comments-list-length u32r)
+ (eval (when (> last emms-info-native--max-num-vorbis-comments)
+ (error "Opus user comment list length %s is too long"
+ last)))
+ (user-comments repeat
+ (user-comments-list-length)
+ (struct emms-info-native--vorbis-comment-field-bindat-spec)))
+ "Opus comment header specification.")
+
+(defconst emms-info-native--opus-tags-magic-array
+ [79 112 117 115 84 97 103 115]
+ "Opus comment header magic pattern `OpusTags'.")
+
+;;;; Ogg code
+
+(defconst emms-info-native--ogg-page-size 65307
+ "Maximum size for a single Ogg container page.")
+
+(defconst emms-info-native--ogg-page-bindat-spec
+ '((capture-pattern vec 4)
+ (eval (unless (equal last emms-info-native--ogg-magic-array)
+ (error "Ogg framing mismatch: expected `%s', got `%s'"
+ emms-info-native--ogg-magic-array
+ last)))
+ (stream-structure-version u8)
+ (eval (unless (= last 0)
+ (error ("Ogg version mismatch: expected 0, got %s")
+ last)))
+ (header-type-flag u8)
+ (granule-position vec 8)
+ (stream-serial-number vec 4)
+ (page-sequence-no vec 4)
+ (page-checksum vec 4)
+ (page-segments u8)
+ (segment-table vec (page-segments))
+ (payload vec (eval (seq-reduce #'+ last 0))))
+ "Ogg page structure specification.")
+
+(defconst emms-info-native--ogg-magic-array
+ [79 103 103 83]
+ "Ogg format magic capture pattern `OggS'.")
+
+(defun emms-info-native--decode-ogg-comments (filename stream-type)
+ "Read and decode comments from Ogg file FILENAME.
+The file is assumed to contain a single stream of type
+STREAM-TYPE, which must either `vorbis' or `opus'.
+
+Return comments in a list of (FIELD . VALUE) cons cells. See
+`emms-info-native--split-vorbis-comment' for details."
+ (let* ((packets (emms-info-native--decode-ogg-packets filename 2))
+ (headers (emms-info-native--decode-ogg-headers packets
+ stream-type))
+ (comments (bindat-get-field headers
+ 'comment-header
+ 'user-comments)))
+ (emms-info-native--extract-vorbis-comments comments)))
+
+(defun emms-info-native--decode-ogg-packets (filename packets)
+ "Read and decode packets from Ogg file FILENAME.
+Read in data from the start of FILENAME, remove Ogg packet
+frames, and concatenate payloads until at least PACKETS number of
+packets have been decoded. Return the decoded packets in a
+vector, concatenated.
+
+Data is read in `emms-info-native--ogg-page-size' chunks. If the
+total length of concatenated packets becomes greater than
+`emms-info-native--max-peek-size', an error is signaled.
+
+Only elementary streams are supported, that is, FILENAME should
+contain only a single logical stream. Note that this assumption
+is not verified: with non-elementary streams packets from
+different streams will be mixed together without an error."
+ (let ((num-packets 0)
+ (offset 0)
+ (stream (vector)))
+ (while (< num-packets packets)
+ (let ((page (emms-info-native--decode-ogg-page filename
+ offset)))
+ (cl-incf num-packets (or (plist-get page :num-packets) 0))
+ (cl-incf offset (plist-get page :num-bytes))
+ (setq stream (vconcat stream (plist-get page :stream)))
+ (when (> (length stream) emms-info-native--max-peek-size)
+ (error "Ogg payload is too large"))))
+ stream))
+
+(defun emms-info-native--decode-ogg-page (filename offset)
+ "Read and decode a single Ogg page from FILENAME.
+Starting reading data from byte offset OFFSET.
+
+Return a plist (:num-packets N :num-bytes B :stream S), where N
+is the number of packets in the page, B is the size of the page
+in bytes, and S is the unframed logical bitstream in a vector.
+Note that N can be zero."
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert-file-contents-literally filename
+ nil
+ offset
+ (+ offset
+ emms-info-native--ogg-page-size))
+ (let* ((page (bindat-unpack emms-info-native--ogg-page-bindat-spec
+ (buffer-string)))
+ (num-packets (emms-info-native--num-of-packets page))
+ (num-bytes (bindat-length emms-info-native--ogg-page-bindat-spec
+ page))
+ (stream (bindat-get-field page 'payload)))
+ (list :num-packets num-packets
+ :num-bytes num-bytes
+ :stream stream))))
+
+(defun emms-info-native--num-of-packets (page)
+ "Return the number of packets in Ogg page PAGE.
+PAGE must correspond to
+`emms-info-native--ogg-page-bindat-spec'."
+ ;; Every element that is less than 255 in the segment table
+ ;; represents a packet boundary.
+ (length (seq-filter (lambda (elt) (< elt 255))
+ (bindat-get-field page 'segment-table))))
+
+(defun emms-info-native--decode-ogg-headers (packets stream-type)
+ "Decode first two stream headers from PACKETS for STREAM-TYPE.
+STREAM-TYPE must be either `vorbis' or `opus'.
+
+Return a structure that corresponds to either
+`emms-info-native--opus-headers-bindat-spec' or
+`emms-info-native--vorbis-headers-bindat-spec'."
+ (cond ((eq stream-type 'vorbis)
+ (bindat-unpack emms-info-native--vorbis-headers-bindat-spec
+ packets))
+ ((eq stream-type 'opus)
+ (let (emms-info-native--opus-channel-count)
+ (bindat-unpack emms-info-native--opus-headers-bindat-spec
+ packets)))
+ (t (error "Unknown stream type %s" stream-type))))
+
+;;;; FLAC code
+
+(defconst emms-info-native--flac-metadata-block-header-bindat-spec
+ '((flags u8)
+ (length u24)
+ (eval (when (or (> last emms-info-native--max-peek-size)
+ (= last 0))
+ (error "FLAC block length %s is invalid" last))))
+ "FLAC metadata block header specification.")
+
+(defconst emms-info-native--flac-comment-block-bindat-spec
+ '((vendor-length u32r)
+ (eval (when (> last emms-info-native--max-vorbis-vendor-length)
+ (error "FLAC vendor length %s is too long" last)))
+ (vendor-string vec (vendor-length))
+ (user-comments-list-length u32r)
+ (eval (when (> last emms-info-native--max-num-vorbis-comments)
+ (error "FLAC user comment list length %s is too long"
+ last)))
+ (user-comments repeat
+ (user-comments-list-length)
+ (struct emms-info-native--vorbis-comment-field-bindat-spec)))
+ "FLAC Vorbis comment block specification.")
+
+(defun emms-info-native--decode-flac-comments (filename)
+ "Read and decode comments from FLAC file FILENAME.
+Return comments in a list of (FIELD . VALUE) cons cells. Only
+FIELDs that are listed in
+`emms-info-native--accepted-vorbis-fields' are returned."
+ (unless (emms-info-native--has-flac-signature filename)
+ (error "Invalid FLAC stream"))
+ (let* ((block (emms-info-native--decode-flac-comment-block
+ filename))
+ (unpacked (bindat-unpack emms-info-native--flac-comment-block-bindat-spec
+ block))
+ (user-comments (bindat-get-field unpacked 'user-comments)))
+ (emms-info-native--extract-vorbis-comments user-comments)))
+
+(defun emms-info-native--has-flac-signature (filename)
+ "Check for FLAC stream marker at the beginning of FILENAME.
+Return t if there is a valid stream marker, nil otherwise."
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert-file-contents-literally filename nil 0 4)
+ (looking-at "fLaC")))
+
+(defun emms-info-native--decode-flac-comment-block (filename)
+ "Read and decode a comment block from FLAC file FILENAME.
+Return the comment block data in a vector."
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (let (comment-block
+ last-flag
+ (offset 4))
+ (while (and (not comment-block) (not last-flag))
+ (insert-file-contents-literally filename
+ nil
+ offset
+ (cl-incf offset 4))
+ (let* ((header (bindat-unpack emms-info-native--flac-metadata-block-header-bindat-spec
+ (buffer-string)))
+ (end (+ offset (bindat-get-field header 'length)))
+ (flags (bindat-get-field header 'flags))
+ (block-type (logand flags #x7F)))
+ (setq last-flag (> (logand flags #x80) 0))
+ (when (> block-type 6)
+ (error "FLAC block type error: expected <= 6, got %s"
+ block-type))
+ (when (= block-type 4)
+ ;; Comment block found, extract it.
+ (insert-file-contents-literally filename nil offset end t)
+ (setq comment-block (vconcat (buffer-string))))
+ (setq offset end)))
+ comment-block)))
+
+;;;; id3v2 (MP3) code
+
+(defconst emms-info-native--id3v2-header-bindat-spec
+ '((file-identifier vec 3)
+ (eval (unless (equal last emms-info-native--id3v2-magic-array)
+ (error "id3v2 framing mismatch: expected `%s', got `%s'"
+ emms-info-native--id3v2-magic-array
+ last)))
+ (version u8)
+ (eval (setq emms-info-native--id3v2-version last))
+ (revision u8)
+ (flags bits 1)
+ (size-bytes vec 4)
+ (size eval (emms-info-native--checked-id3v2-size 'tag last)))
+ "id3v2 header specification.")
+
+(defconst emms-info-native--id3v2-magic-array
+ [#x49 #x44 #x33]
+ "id3v2 header magic pattern `ID3'.")
+
+(defconst emms-info-native--id3v2-frame-header-bindat-spec
+ '((id str (eval (if (= emms-info-native--id3v2-version 2) 3 4)))
+ (eval (unless (emms-info-native--valid-id3v2-frame-id-p last)
+ (error "id3v2 frame id `%s' is invalid" last)))
+ (size-bytes vec (eval (if (= emms-info-native--id3v2-version 2) 3 4)))
+ (size eval (emms-info-native--checked-id3v2-size 'frame last))
+ (flags bits (eval (if (= emms-info-native--id3v2-version 2) 0 2))))
+ "id3v2 frame header specification.")
+
+(defconst emms-info-native--id3v2-frame-to-info
+ '(("TAL" . "album")
+ ("TALB" . "album")
+ ("TPE2" . "albumartist")
+ ("TSO2" . "albumartistsort")
+ ("TSOA" . "albumsort")
+ ("TP1" . "artist")
+ ("TPE1" . "artist")
+ ("TSOP" . "artistsort")
+ ("TCM" . "composer")
+ ("TCOM" . "composer")
+ ("TSOC" . "composersort")
+ ("TDRC" . "date")
+ ("TPA" . "discnumber")
+ ("TPOS" . "discnumber")
+ ("TCON" . genre)
+ ("TPUB" . "label")
+ ("TDOR" . "originaldate")
+ ("TOR" . "originalyear")
+ ("TORY" . "originalyear")
+ ("TIT2" . "title")
+ ("TT2" . "title")
+ ("TSOT" . "titlesort")
+ ("TRK" . "tracknumber")
+ ("TRCK" . "tracknumber")
+ ("TYE" . "year")
+ ("TYER" . "year")
+ ("TXXX" . user-defined))
+ "Mapping from id3v2 frame identifiers to EMMS info fields.
+
+Sources:
+
+- URL `https://picard-docs.musicbrainz.org/en/appendices/tag_mapping.html'
+- URL `http://wiki.hydrogenaud.io/index.php?title=Foobar2000:ID3_Tag_Mapping'")
+
+(defconst emms-info-native--id3v1-genres
+ '((0 . "Blues")
+ (1 . "Classic Rock")
+ (2 . "Country")
+ (3 . "Dance")
+ (4 . "Disco")
+ (5 . "Funk")
+ (6 . "Grunge")
+ (7 . "Hip-Hop")
+ (8 . "Jazz")
+ (9 . "Metal")
+ (10 . "New Age")
+ (11 . "Oldies")
+ (12 . "Other")
+ (13 . "Pop")
+ (14 . "R&B")
+ (15 . "Rap")
+ (16 . "Reggae")
+ (17 . "Rock")
+ (18 . "Techno")
+ (19 . "Industrial")
+ (20 . "Alternative")
+ (21 . "Ska")
+ (22 . "Death Metal")
+ (23 . "Pranks")
+ (24 . "Soundtrack")
+ (25 . "Euro-Techno")
+ (26 . "Ambient")
+ (27 . "Trip-Hop")
+ (28 . "Vocal")
+ (29 . "Jazz+Funk")
+ (30 . "Fusion")
+ (31 . "Trance")
+ (32 . "Classical")
+ (33 . "Instrumental")
+ (34 . "Acid")
+ (35 . "House")
+ (36 . "Game")
+ (37 . "Sound Clip")
+ (38 . "Gospel")
+ (39 . "Noise")
+ (40 . "AlternRock")
+ (41 . "Bass")
+ (42 . "Soul")
+ (43 . "Punk")
+ (44 . "Space")
+ (45 . "Meditative")
+ (46 . "Instrumental Pop")
+ (47 . "Instrumental Rock")
+ (48 . "Ethnic")
+ (49 . "Gothic")
+ (50 . "Darkwave")
+ (51 . "Techno-Industrial")
+ (52 . "Electronic")
+ (53 . "Pop-Folk")
+ (54 . "Eurodance")
+ (55 . "Dream")
+ (56 . "Southern Rock")
+ (57 . "Comedy")
+ (58 . "Cult")
+ (59 . "Gangsta")
+ (60 . "Top 40")
+ (61 . "Christian Rap")
+ (62 . "Pop/Funk")
+ (63 . "Jungle")
+ (64 . "Native American")
+ (65 . "Cabaret")
+ (66 . "New Wave")
+ (67 . "Psychadelic")
+ (68 . "Rave")
+ (69 . "Showtunes")
+ (70 . "Trailer")
+ (71 . "Lo-Fi")
+ (72 . "Tribal")
+ (73 . "Acid Punk")
+ (74 . "Acid Jazz")
+ (75 . "Polka")
+ (76 . "Retro")
+ (77 . "Musical")
+ (78 . "Rock & Roll")
+ (79 . "Hard Rock")
+ (80 . "Folk")
+ (81 . "Folk-Rock")
+ (82 . "National Folk")
+ (83 . "Swing")
+ (84 . "Fast Fusion")
+ (85 . "Bebob")
+ (86 . "Latin")
+ (87 . "Revival")
+ (88 . "Celtic")
+ (89 . "Bluegrass")
+ (90 . "Avantgarde")
+ (91 . "Gothic Rock")
+ (92 . "Progressive Rock")
+ (93 . "Psychedelic Rock")
+ (94 . "Symphonic Rock")
+ (95 . "Slow Rock")
+ (96 . "Big Band")
+ (97 . "Chorus")
+ (98 . "Easy Listening")
+ (99 . "Acoustic")
+ (100 . "Humour")
+ (101 . "Speech")
+ (102 . "Chanson")
+ (103 . "Opera")
+ (104 . "Chamber Music")
+ (105 . "Sonata")
+ (106 . "Symphony")
+ (107 . "Booty Bass")
+ (108 . "Primus")
+ (109 . "Porn Groove")
+ (110 . "Satire")
+ (111 . "Slow Jam")
+ (112 . "Club")
+ (113 . "Tango")
+ (114 . "Samba")
+ (115 . "Folklore")
+ (116 . "Ballad")
+ (117 . "Power Ballad")
+ (118 . "Rhythmic Soul")
+ (119 . "Freestyle")
+ (120 . "Duet")
+ (121 . "Punk Rock")
+ (122 . "Drum Solo")
+ (123 . "A cappella")
+ (124 . "Euro-House")
+ (125 . "Dance Hall"))
+ "id3v1 genres.")
+
+(defconst emms-info-native--id3v2-text-encodings
+ '((0 . latin-1)
+ (1 . utf-16)
+ (2 . uft-16be)
+ (3 . utf-8))
+ "id3v2 text encodings.")
+
+(defun emms-info-native--valid-id3v2-frame-id-p (id)
+ "Return t if ID is a proper id3v2 frame identifier, nil otherwise."
+ (if (= emms-info-native--id3v2-version 2)
+ (string-match "[A-Z0-9]\\{3\\}" id)
+ (string-match "[A-Z0-9]\\{4\\}" id)))
+
+(defun emms-info-native--checked-id3v2-size (elt bytes)
+ "Calculate id3v2 element ELT size from BYTES.
+ELT must be either \\='tag or \\='frame.
+
+Return the size. Signal an error if the size is zero."
+ (let ((size (cond ((eq elt 'tag)
+ (emms-info-native--decode-id3v2-size bytes t))
+ ((eq elt 'frame)
+ (if (= emms-info-native--id3v2-version 4)
+ (emms-info-native--decode-id3v2-size bytes t)
+ (emms-info-native--decode-id3v2-size bytes nil))))))
+ (if (zerop size)
+ (error "id3v2 tag/frame size is zero")
+ size)))
+
+(defun emms-info-native--decode-id3v2-size (bytes syncsafe)
+ "Decode id3v2 element size from BYTES.
+Depending on SYNCSAFE, BYTES are interpreted as 7- or 8-bit
+bytes, MSB first.
+
+Return the decoded size."
+ (let ((num-bits (if syncsafe 7 8)))
+ (apply '+ (seq-map-indexed (lambda (elt idx)
+ (* (expt 2 (* num-bits idx)) elt))
+ (reverse bytes)))))
+
+(defun emms-info-native--decode-id3v2 (filename)
+ "Read and decode id3v2 metadata from FILENAME.
+Return metadata in a list of (FIELD . VALUE) cons cells, or nil
+in case of errors or if there were no known fields in FILENAME.
+
+See `emms-info-native--id3v2-frame-to-info' for recognized
+fields."
+ (condition-case nil
+ (let* (emms-info-native--id3v2-version
+ (header (emms-info-native--decode-id3v2-header filename))
+ (tag-size (bindat-get-field header 'size))
+ (unsync (memq 7 (bindat-get-field header 'flags)))
+ (offset 10))
+ (when (memq 6 (bindat-get-field header 'flags))
+ ;; Skip the extended header.
+ (cl-incf offset
+ (emms-info-native--checked-id3v2-ext-header-size filename)))
+ (emms-info-native--decode-id3v2-frames filename
+ offset
+ (+ tag-size 10)
+ unsync))
+ (error nil)))
+
+(defun emms-info-native--decode-id3v2-header (filename)
+ "Read and decode id3v2 header from FILENAME."
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert-file-contents-literally filename nil 0 10)
+ (bindat-unpack emms-info-native--id3v2-header-bindat-spec
+ (buffer-string))))
+
+(defun emms-info-native--checked-id3v2-ext-header-size (filename)
+ "Read and decode id3v2 extended header size from FILENAME.
+Return the size. Signal an error if the size is zero."
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert-file-contents-literally filename nil 10 14)
+ (emms-info-native--checked-id3v2-size 'frame (buffer-string))))
+
+(defun emms-info-native--decode-id3v2-frames (filename begin end unsync)
+ "Read and decode id3v2 text frames from FILENAME.
+BEGIN should be the offset of first byte of the first frame, and
+END should be the offset after the complete id3v2 tag.
+
+If UNSYNC is t, the frames are assumed to have gone through
+unsynchronization and decoded as such.
+
+Return metadata in a list of (FIELD . VALUE) cons cells."
+ (let ((offset begin)
+ (limit (- end (emms-info-native--id3v2-frame-header-size)))
+ comments)
+ (condition-case nil
+ (while (< offset limit)
+ (let* ((frame-data (emms-info-native--decode-id3v2-frame filename
+ offset
+ unsync))
+ (next-frame-offset (car frame-data))
+ (comment (cdr frame-data)))
+ (when comment (push comment comments))
+ (setq offset next-frame-offset)))
+ (error nil))
+ comments))
+
+(defun emms-info-native--id3v2-frame-header-size ()
+ "Return the last decoded header size in bytes."
+ (if (= emms-info-native--id3v2-version 2) 6 10))
+
+(defun emms-info-native--decode-id3v2-frame (filename offset unsync)
+ (let* ((header (emms-info-native--decode-id3v2-frame-header filename
+ offset))
+ (info-id (emms-info-native--id3v2-frame-info-id header))
+ (data-offset (car header))
+ (size (bindat-get-field (cdr header) 'size)))
+ (if (or info-id unsync)
+ ;; Note that if unsync is t, we have to always read the frame
+ ;; to determine next-frame-offset.
+ (let* ((data (emms-info-native--read-id3v2-frame-data filename
+ data-offset
+ size
+ unsync))
+ (next-frame-offset (car data))
+ (value (emms-info-native--decode-id3v2-frame-data (cdr data)
+ info-id)))
+ (cons next-frame-offset value))
+ ;; Skip the frame.
+ (cons (+ data-offset size) nil))))
+
+(defun emms-info-native--decode-id3v2-frame-header (filename begin)
+ "Read and decode id3v2 frame header from FILENAME.
+Start reading from offset BEGIN.
+
+Return a cons cell (OFFSET . FRAME), where OFFSET is the byte
+offset after the frame header, and FRAME is the decoded frame."
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (let ((end (+ begin (emms-info-native--id3v2-frame-header-size))))
+ (insert-file-contents-literally filename nil begin end)
+ (cons end (bindat-unpack emms-info-native--id3v2-frame-header-bindat-spec
+ (buffer-string))))))
+
+(defun emms-info-native--id3v2-frame-info-id (frame)
+ "Return the emms-info identifier for FRAME.
+If there is no such identifier, return nil."
+ (cdr (assoc (bindat-get-field frame 'id)
+ emms-info-native--id3v2-frame-to-info)))
+
+(defun emms-info-native--read-id3v2-frame-data (filename
+ begin
+ num-bytes
+ unsync)
+ "Read NUM-BYTES of raw id3v2 frame data from FILENAME.
+Start reading from offset BEGIN. If UNSYNC is t, all 'FF 00'
+byte combinations are replaced by 'FF'. Replaced byte pairs are
+counted as one, instead of two, towards NUM-BYTES.
+
+Return a cons cell (OFFSET . DATA), where OFFSET is the byte
+offset after NUM-BYTES bytes have been read, and DATA is the raw
+data."
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (if unsync
+ ;; Reverse unsynchronization.
+ (let ((peek-end (+ begin (* 2 num-bytes)))
+ (end num-bytes))
+ (insert-file-contents-literally filename nil begin peek-end)
+ (goto-char (point-min))
+ (while (and (re-search-forward (string 255 0) nil t)
+ (< (point) end))
+ (replace-match (string 255))
+ (cl-incf end 1))
+ (delete-region (1+ num-bytes) (point-max))
+ (cons (+ begin end) (buffer-string)))
+ ;; No unsynchronization: read the data as-is.
+ (let ((end (+ begin num-bytes)))
+ (insert-file-contents-literally filename nil begin end)
+ (cons end (buffer-string))))))
+
+(defun emms-info-native--decode-id3v2-frame-data (data info-id)
+ "Decode id3v2 text frame data DATA.
+If INFO-ID is `user-defined', assume that DATA is a TXXX frame
+with key/value-pair. Extract the key and, if it is a mapped
+element in `emms-info-native--id3v2-frame-to-info', use it as
+INFO-ID.
+
+If INFO-ID is `genre', assume that DATA is either an integral
+id3v1 genre reference or a plain genre string. In the former
+case map the reference to a string via
+`emms-info-native--id3v1-genres'; in the latter case use the
+genre string verbatim.
+
+Return a cons cell (INFO-ID . VALUE) where VALUE is the decoded
+string."
+ (when info-id
+ (let ((str (emms-info-native--decode-id3v2-string data)))
+ (cond ((stringp info-id) (cons info-id str))
+ ((eq info-id 'genre)
+ (if (string-match "^(?\\([0-9]+\\))?" str)
+ (let ((v1-genre (assoc (string-to-number (match-string 1 str))
+ emms-info-native--id3v1-genres)))
+ (when v1-genre (cons "genre" (cdr v1-genre))))
+ (cons "genre" str)))
+ ((eq info-id 'user-defined)
+ (let* ((key-val (split-string str (string 0)))
+ (key (downcase (car key-val)))
+ (val (cadr key-val)))
+ (when (rassoc key emms-info-native--id3v2-frame-to-info)
+ (cons key val))))))))
+
+(defun emms-info-native--decode-id3v2-string (bytes)
+ "Decode id3v2 text information from BYTES.
+Remove the terminating null byte, if any.
+
+Return the text as string."
+ (let* ((encoding (emms-info-native--id3v2-text-encoding bytes))
+ (string (mapconcat #'byte-to-string (seq-rest bytes) ""))
+ (decoded (decode-coding-string string encoding)))
+ (when (> (length decoded) 0)
+ (if (equal (substring decoded -1) "\0")
+ (substring decoded 0 -1)
+ decoded))))
+
+(defun emms-info-native--id3v2-text-encoding (bytes)
+ "Return the encoding for text information BYTES."
+ (cdr (assoc (seq-first bytes)
+ emms-info-native--id3v2-text-encodings)))
+
+;;;; EMMS code
+
+(defun emms-info-native (track)
+ "Set info fields for TRACK.
+Supports Ogg Vorbis/Opus, FLAC, and MP3 files."
+ (condition-case env
+ (let* ((filename (emms-track-name track))
+ (info-fields (emms-info-native--decode-info-fields filename)))
+ (dolist (field info-fields)
+ (let ((name (intern (concat "info-" (car field))))
+ (value (cdr field)))
+ (unless (zerop (length value))
+ (emms-track-set track
+ name
+ (if (eq name 'info-playing-time)
+ (string-to-number value)
+ (string-trim-right value)))))))
+ (error (message "emms-info-native error processing %s: %s"
+ (emms-track-name track) env))))
+
+(defun emms-info-native--decode-info-fields (filename)
+ "Decode info fields from FILENAME.
+Return a list of (FIELD . VALUE) cons cells, where FIELD is an
+info field and VALUE is the corresponding info value. Both are
+strings."
+ (let ((stream-type (emms-info-native--find-stream-type filename)))
+ (cond ((or (eq stream-type 'vorbis) (eq stream-type 'opus))
+ (emms-info-native--decode-ogg-comments filename stream-type))
+ ((eq stream-type 'flac)
+ (emms-info-native--decode-flac-comments filename))
+ ((eq stream-type 'mp3)
+ (emms-info-native--decode-id3v2 filename))
+ ((eq stream-type 'spc)
+ (emms-info-spc--decode-id666 filename))
+ (t nil))))
+
+(defun emms-info-native--find-stream-type (filename)
+ "Deduce the stream type from FILENAME.
+This is a naive implementation that relies solely on filename
+extension.
+
+Return one of symbols `vorbis', `opus', `flac', or `mp3'."
+ (let ((case-fold-search t))
+ (cond ((string-match ".ogg$" filename) 'vorbis)
+ ((string-match ".opus$" filename) 'opus)
+ ((string-match ".flac$" filename) 'flac)
+ ((string-match ".mp3$" filename) 'mp3)
+ ((string-match ".spc$" filename) 'spc)
+ (t nil))))
+
+(provide 'emms-info-native)
+
+;;; emms-info-native.el ends here