emms-cache.el

;;; emms-cache.el --- persistence for emms-track  -*- lexical-binding: t; -*-

;; Copyright (C) 2006, 2007, 2008, 2009, 2022  Free Software Foundation, Inc.

;; Author: Damien Elmes <emacs@repose.cx>, Yoni Rabkin <yrk@gnu.org>
;; Keywords: emms, mp3, mpeg, multimedia

;; 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:

;; The cache is a mapping of a full path name to information, and so
;; it is invalidated when you rename or move files about.  It also
;; does not differentiate between file or uri tracks.

;; Because cache lookups are much faster than disk access, this works
;; much better with a emms-later-do-interval of something like 0.001.  Also
;; consider using synchronous mode, as it's quite fast now.

;; This code is activated by (emms-standard) and above.

;; To activate it by hand, use:

;; (emms-cache 1)

;;; Code:

(require 'emms)
(require 'emms-info)

(when (fboundp 'define-hash-table-test)
  (define-hash-table-test 'string-hash 'string= 'sxhash))

(defvar emms-cache-db (make-hash-table
                       :test (if (fboundp 'define-hash-table-test)
                                 'string-hash
                               'equal))
  "A mapping of paths to file info.
This is used to cache over emacs sessions.")

(defvar emms-cache-dirty nil
  "True if the cache has been updated since init.")

(defcustom emms-cache-file (concat (file-name-as-directory emms-directory) "cache")
  "A file used to store cached file information over sessions."
  :group 'emms
  :type 'file)

(defcustom emms-cache-file-coding-system 'utf-8
  "Coding system used for saving `emms-cache-file'."
  :group 'emms
  :type 'coding-system)

(defun emms-cache (arg)
  "Turn on Emms caching if ARG is positive, off otherwise."
  (interactive "p")
  (if (and arg (> arg 0))
      (progn
	(unless emms-cache-dirty
	  (emms-cache-restore))
        (unless noninteractive
          (add-hook 'kill-emacs-hook 'emms-cache-save))
        (setq emms-cache-get-function 'emms-cache-get)
        (setq emms-cache-set-function 'emms-cache-set)
        (setq emms-cache-modified-function 'emms-cache-dirty))
    (remove-hook 'kill-emacs-hook 'emms-cache-save)
    (setq emms-cache-get-function nil)
    (setq emms-cache-set-function nil)
    (setq emms-cache-modified-function nil)))

;;;###autoload
(defun emms-cache-enable ()
  "Enable caching of Emms track data."
  (interactive)
  (emms-cache 1)
  (message "Emms cache enabled"))

;;;###autoload
(defun emms-cache-disable ()
  "Disable caching of Emms track data."
  (interactive)
  (emms-cache -1)
  (message "Emms cache disabled"))

;;;###autoload
(defun emms-cache-toggle ()
  "Toggle caching of Emms track data."
  (interactive)
  (if emms-cache-get-function
      (emms-cache-disable)
    (emms-cache-enable)))

(defsubst emms-cache-dirty (&rest _ignored)
  "Mark the cache as dirty."
  (setq emms-cache-dirty t))

(defun emms-cache-get (type path)
  "Return a cache element for PATH, or nil."
  (ignore type) ;; implicitly ignored before 2021-03-02
  (gethash path emms-cache-db))

(defun emms-cache-set (type path track)
  "Set PATH to TRACK in the cache."
  (ignore type) ;; implicitly ignored before 2021-03-02
  (puthash path track emms-cache-db)
  (emms-cache-dirty))

(defun emms-cache-del (path)
  "Remove a track from the cache, with key PATH."
  (remhash path emms-cache-db)
  (emms-cache-dirty))

(defun emms-cache-save ()
  "Save the track cache to a file."
  (interactive)
  (when emms-cache-dirty
    (message "Saving emms track cache...")
    (with-temp-buffer
      (insert
       (concat ";;; .emms-cache -*- mode: emacs-lisp; coding: "
               (symbol-name emms-cache-file-coding-system)
               "; -*-\n"))
      (maphash (lambda (k v)
		 (insert (format
                          "(puthash %S '%S emms-cache-db)\n" k v)))
               emms-cache-db)
      (when (fboundp 'set-buffer-file-coding-system)
	(set-buffer-file-coding-system emms-cache-file-coding-system))
      (unless (file-directory-p (file-name-directory emms-cache-file))
	(make-directory (file-name-directory emms-cache-file)))
      (write-region (point-min) (point-max) emms-cache-file)
      (message "Saving emms track cache...done"))
    (setq emms-cache-dirty nil)))

(defun emms-cache-restore ()
  "Restore the track cache from a file."
  (interactive)
  (load emms-cache-file t nil t)
  (setq emms-cache-dirty nil))

(defun emms-cache-sync (arg)
  "Sync the cache with the data on disc.
Remove non-existent files, and update data for files which have
been modified.  With prefix argument, update data for all files
regardless of whether they have been modified or not."
  (interactive "P")
  (let (removed)
    (maphash (lambda (path track)
               (when (emms-track-file-p track)
                 ;; if no longer here, remove
                 (if (not (file-exists-p path))
                     (progn
                       (remhash path emms-cache-db)
                       (setq removed t))
                   (let ((file-mtime (emms-info-track-file-mtime track))
                         (info-mtime (emms-track-get track 'info-mtime)))
                     (when (or (not info-mtime)
                               (emms-time-less-p info-mtime file-mtime)
                               arg)
                       (emms-info-initialize-track track arg))))))
             emms-cache-db)
    (when removed
      (setq emms-cache-dirty t))))

(defun emms-cache-reset ()
  "Reset the cache."
  (interactive)
  (when (yes-or-no-p "Really reset the cache? ")
    (setq emms-cache-db
          (make-hash-table
           :test (if (fboundp 'define-hash-table-test)
                     'string-hash
                   'equal)))
    (setq emms-cache-dirty t)
    (emms-cache-save)))

(provide 'emms-cache)
;;; emms-cache.el ends here