;;; edit-metadata.el --- Edit embedded metadata  -*- lexical-binding:t -*-

;; Copyright ® 2026 Michael Piotrowski

;; Author: Michael Piotrowski <mxp@dynalabs.de>
;; Maintainer: Michael Piotrowski <mxp@dynalabs.de>
;; Description: Edit embedded metadata
;; URL: https://codeberg.org/mxpi/edit-metadata
;; Created: 2026-01-23
;; Package-Version: 20260307.1827
;; Package-Revision: 52f7b4818e7a
;; Package-Requires: ((exiftool "0.3.2") (emacs "28.1") (compat "29.1"))
;; Keywords: files multimedia

;; This program 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 of the License, or
;; (at your option) any later version.

;; This program 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 this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; A simple interface (based on `widget') for editing metadata in
;; images and other file types supported by ExifTool (via the
;; `exiftool' package).

;; The command `edit-metadata-find-file' prompts the user for an
;; existing file and then opens a buffer with selected metadata items.
;; The values can be edited and written to the file, and new items can
;; be added.

;;; Code:

(require 'exiftool)
(require 'widget)
(eval-when-compile
  (require 'wid-edit))
(require 'image-dired)
(require 'compat)

(defvar-keymap edit-metadata-mode-keymap
  :parent widget-keymap
  "C-c C-a" #'edit-metadata-add-tag
  "C-c C-c" #'edit-metadata-write-file-and-quit
  "C-c C-k" #'quit-window
  "C-c C-t" #'edit-metadata-goto-tag
  "C-x C-s" #'edit-metadata-write-file)

(defvar-keymap edit-metadata-field-keymap
  :parent widget-field-keymap
  "C-c C-a" #'edit-metadata-add-tag
  "C-c C-c" #'edit-metadata-write-file-and-quit
  "C-c C-k" #'quit-window
  "C-c C-t" #'edit-metadata-goto-tag
  "C-x C-s" #'edit-metadata-write-file
  "RET"     #'edit-metadata--return)

;; See also https://emacs.stackexchange.com/questions/39192/emacs-widget-library
(defun edit-metadata--return (pos &optional event)
  "Run `widget-field-activate' even when point is just behind field.

This is a workaround for the following issue: In principle, when
`widget-field-keymap' is active, point should be inside an
editable field.  However, on the right field boundary, i.e.,
outside of the field, RET is still bound to
`widget-field-activate', but actually inserts a newline.

Argument POS is ignored; instead, point is moved to the beginning
of the field and `widget-field-activate` is called with the
current point position.

Optional argument EVENT is passed to `widget-field-activate'."
  (interactive "@d")
  (let ((field (widget-field-at pos))
        (just-after-field (widget-field-at (1- pos))))
    (when (or field just-after-field)
      (widget-beginning-of-line)
      (widget-field-activate (point) event))))

;; Adapted from the page-break-lines package
(defun edit-metadata--update-display-table ()
  "Display the form feed character (^L, codepoint 12) as a line."
  (when (not buffer-display-table)
    (setq buffer-display-table (make-display-table)))
  (aset buffer-display-table 12
        (vconcat (make-list (window-max-chars-per-line (selected-window))
                            (make-glyph-code ?─ 'font-lock-comment-face))))
  (redraw-frame))

(defgroup edit-metadata nil
  "Edit metadata of files."
  :group 'files)

(defcustom edit-metadata-immediate-write nil
  "If non-nil, immediately write changes to the file.

Changes are written when pressing RET in a field."
  :type 'boolean)

(defvar-local edit-metadata-file nil
  "Name of the file containing the metadata in the current buffer.
This should be an absolut filename")

(defvar-local edit-metadata-mimetype nil
  "MIME type of the file associated with the metadata.")

(defvar-local edit-metadata-error nil
  "ExifTool error message.")

(defvar-local edit-metadata-relevant-tags nil
  "List of tags relevant for the current file.

This is the list of tags from `edit-metadata-tags' corresponding
to the MIME type of the current file, without prefixes.")

(defvar-local edit-metadata-current-tags nil
  "List of tags currently used in the buffer.

Used by `edit-metadata-goto-tag' and `edit-metadata-add-tag'.")

(defvar-local edit-metadata-widgets '()
  "The widgets used in the buffer.")

(defconst edit-metadata--fallback-thumb
  (create-image (base64-decode-string
                 "iVBORw0KGgoAAAANSUhEUgAAADQAAAA+AgMAAAAZjdAeAAAAIGNIUk0AAH
omAACAhAAA+gAAAIDoAAB1MAAA6mAAADqYAAAXcJy6UTwAAAAMUExURQCAAAAAAP///////7ITTq
oAAAABdFJOUwBA5thmAAAAAWJLR0QDEQxM8gAAAAlwSFlzAAAAYAAAAF8AqLVo8wAAAAd0SU1FB+
oBGxQzMX/pBcwAAABKSURBVCjP7dMhEsAwEELRvSRm74fhlInJpJ0UdEVwz/MLe1X1VmuNSQhiEo
J49WdxPsRKCmJ7QVZsL+jUunF/KB70kcChWIQtaQBfDNEQvg7rRgAAAABJRU5ErkJggg==") 'png t)
  "Fallback thumbnail for non-image files.

This is a Base64-encoded 52×62-pixel 1-bit PNG image.")

(defcustom edit-metadata-tags
  '(("application/pdf" . ("Author" "CreateDate" "Keywords" "Subject" "Language"
                          "PDFVersion" "Title" "MWG:Copyright" "MWG:Description"
                          "XMP:Source" "XMP:WebStatement"))
    ("image/.*" . ("MWG:Copyright" "MWG:Creator" "MWG:DateTimeOriginal"
                   "MWG:Description" "MWG:Rating" "XMP:Source"
                   "XMP:WebStatement"))
    ("video/.*" . ("MWG:Copyright" "MWG:Creator" "MWG:DateTimeOriginal"
                   "MWG:Description" "MWG:Rating" "XMP:Source"
                   "XMP:WebStatement"))
    ("audio/.*" . ("Title" "Artist" "Date" "Album" "TrackNumber" "Albumartist"
                   "Releasecountry" "Label" "Website" "Genre" "Catalognumber"
                   "Language"))
    (".*" . ("FileName")))
  "Alist of tags that should be displayed for certain filetypes.

The keys are regular expressions that are matched against the
value of the MIMEType tag."
  :type '(alist :key-type string
                :value-type (repeat string)))

(defun edit-metadata-revert ()
  "Reload metadata from the current file."
  (interactive)
  (edit-metadata-find-file edit-metadata-file))

(defun edit-metadata-goto-tag (tag)
  "Move point to the field for tag TAG."
  (interactive
   (let ((completion-ignore-case t))
     (list (completing-read "Tag: " edit-metadata-current-tags nil t nil nil))))

  (save-restriction
    (goto-char (point-min))
    (re-search-forward (concat "^" (regexp-quote tag)))
    ;; (beginning-of-line)
    (widget-forward 1)))

(defun edit-metadata-add-tag (tag)
  "Add new tag TAG.

Prompts the user to select a tag to add, adds a corresponding
field, and places the point in the field.  Only tags from
`edit-metadata-tags' that are not already in use are offered for
selection.  Note, however, that lang-alt tags (e.g.,
“Description-fr”) must be listed in `edit-metadata-tags' in order
to insert them using `edit-metadata-add-tag'."
  (interactive
   (let ((completion-ignore-case t)
         (exclude edit-metadata-current-tags)) ; Why is this needed!?
     (list
      (completing-read "Add Tag: " edit-metadata-relevant-tags
       (lambda (elt) (not (member elt exclude))) ; Offer only as yet unused tags
       t)))
   edit-metadata-mode)

  (goto-char (point-min))
  (forward-page)
  (forward-line -1)

  (push `(,tag . ,(edit-metadata--make-field tag ""))
        edit-metadata-widgets)

  ;; If the field doesn't reach to the end of the line, follow it with
  ;; a newline
  (when (widget-get (cdr (car edit-metadata-widgets)) :size)
    (widget-insert "\n"))

  (push tag edit-metadata-current-tags)

  (widget-setup)
  (widget-backward 1))

;;;###autoload
(defun edit-metadata-find-file (file)
  "Edit the metadata of FILE."
  (interactive "fFile: ")

  (unless (file-regular-p file)
    (user-error "Not a regular file: %s" file))
  
  (switch-to-buffer "*edit-metadata-metadata*")
  (kill-all-local-variables)
  (if (not (eq major-mode 'edit-metadata-mode))
      (edit-metadata-mode))
  (let ((inhibit-read-only t))
    (erase-buffer))
  (remove-overlays)

  (setq edit-metadata-file (expand-file-name file))
    
  (let* ((metadata (sort (exiftool-read edit-metadata-file)
                         (lambda (x y) (string< (car x) (car y)))))
         (mimetype (or (cdr (assoc "MIMEType" metadata)) "UNKNOWN"))
         (tags (mapcar (lambda (tagname) (string-trim tagname "^.*?:"))
                       (flatten-tree
                        (remq nil
                              (mapcar
                               (lambda (entry)
                                 (when (string-match-p (car entry) mimetype)
                                   (cdr entry)))
                               edit-metadata-tags))))))

    (setq edit-metadata-mimetype mimetype)
    (setq edit-metadata-relevant-tags tags)

    ;; Start inserting widgets into the buffer

    (widget-insert "\n")

    ;; Insert a thumbnail of the file.  This relies on functions
    ;; provided by Image-Dired.  If no thumbnail exists, it is
    ;; generated on the fly.  For non-image files, display a generic
    ;; icon (stored in `image-dired--fallback-thumb').
    (let* ((thumb-file (image-dired-thumb-name edit-metadata-file))
           (img (create-image thumb-file)))
      (unless (file-exists-p thumb-file)
        (if (string-match "^\\(:?image/.*\\|application/pdf\\)" mimetype)
            (image-dired-create-thumb-1 edit-metadata-file thumb-file)
          (setq img edit-metadata--fallback-thumb)))
      (insert-image img))

    (widget-insert " ")
    (widget-create 'file-link file)
    (widget-insert "\n\n")
    
    (dolist (item metadata)
      (let ((tag (car item))
            (value (cdr item)))
        (when (or (member (car item) tags)
                  ;; XMP dc lang-alt tags.  This ensures that they're
                  ;; read even if not explicitly specified in
                  ;; `edit-metadata-tags', but in order to be able to
                  ;; add them, they must nevertheless be listed there.
                  (string-match
                   (concat (regexp-opt '("Description" "Rights" "Title") nil) "-.+")
                   (car item)))
          ;; (print (car item)))
          (push
           `(,tag . ,(edit-metadata--make-field tag value))
           edit-metadata-widgets)
          (push tag edit-metadata-current-tags)
          (when (widget-get (cdar edit-metadata-widgets) :size)
            (widget-insert "\n")))))
        
    (setq edit-metadata-error (or (cdr (assoc "Error" metadata)) "")))

  ;; Insert a page break.  This is used by `edit-metadata-add-tag' to
  ;; find the end of the list of fields.

  (widget-insert "\n\f\n\n")
  (edit-metadata--update-display-table) ; display \f as full-width rule
  
  ;; Create the push buttons
  
  (widget-create 'push-button
                 :notify (lambda (&rest _) (quit-window))
                 :button-face 'custom-button
                 :format "%[ %t %]"
                 :tag "Cancel")
  (widget-insert " ")
  (widget-create 'push-button
                 :notify (lambda (&rest _) (edit-metadata-write-file-and-quit))
                 :button-face 'custom-button
                 :format "%[ %t %]"
                 :tag "Save")
  
  (use-local-map edit-metadata-mode-keymap)
  
  ;;

  (widget-setup)

  (setq-local header-line-format
              '((:eval (substitute-command-keys
                        " Go to tag \\[edit-metadata-goto-tag]"))
                (:eval (substitute-command-keys
                        ", add tag \\[edit-metadata-add-tag]"))
                (:eval (substitute-command-keys
                        ", save \\[edit-metadata-write-file-and-quit]"))
                (:eval (substitute-command-keys
                        ", cancel \\[quit-window]"))
                "   "
                (:propertize
                 ((:eval
                   (when (not (string= edit-metadata-error "")) "⚠ "))
                  edit-metadata-error)
                 face error)))

  (beginning-of-line))

(defun edit-metadata-write-file ()
  "Write metadata tag values to the file."
  (interactive)

  ;; [DEBUG]
  ;; (print (mapcar (lambda (item)
  ;;                  `(,(car item) . ,(widget-value (cdr item))))
  ;;                edit-metadata-widgets))
  (apply #'exiftool-write edit-metadata-file
         (mapcar (lambda (item) `(,(car item) . ,(widget-value (cdr item)))) edit-metadata-widgets)))

(defun edit-metadata-write-file-and-quit ()
  "Write metadata tag values to the file and quit."
  (interactive)
  (edit-metadata-write-file)
  (quit-window))

(defun edit-metadata--make-field (tag value)
  "Return an editable-field widget with label TAG and value VALUE.

This is a utility function for inserting editable fields with
common settings and basic validation for certain fields."
  (widget-create 'editable-field
                 :tag tag
                 :format (concat (propertize (string-pad tag 16) 'face 'bold) " %v")
                 :keymap edit-metadata-field-keymap
                 :size (cond ((string-match "Date" tag) 28)
                             ((string-match "Rating" tag) 2)
                             (t nil))
                 :valid-regexp          ; Very basic validation
                 (cond ((string-match "Date" tag) "^[-+0-9.: ]\\{,28\\}$" "")
                       ((string= "Rating" tag) "^\\(:?[0-5]\\(?:\\.[0-9]+\\)?\\|-1\\)$")
                       (t ".*"))
                 :action (lambda (widget &rest _)
                           (if (widget-apply widget :validate)
                               (user-error "Validation error: %s!" (widget-get widget :error))
                             (message "%s is ok!" (widget-value widget))
                             (when edit-metadata-immediate-write
                               (edit-metadata-write-file))
                             (widget-forward 1)))
                 :help-echo tag ; [TODO]
                 (or value "")))

(define-derived-mode edit-metadata-mode
  nil "edit-metadata"
  "Edited embedded metadata.
\\{edit-metadata-mode-keymap}
See the customization group `edit-metadata' for options."
  :interactive nil
  :group 'edit-metadata)

(provide 'edit-metadata)

;;; edit-metadata.el ends here
