;;; denotef.el --- Rename files using Denote file-naming scheme -*- lexical-binding: t -*-

;; Copyright (C) 2026 Pavel Popov

;; Author: Pavel Popov
;; Version: 0.1.1
;; Package-Requires: ((emacs "30.1"))
;; Keywords: files, convenience

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

;;; Commentary:

;; Minimal package to rename files using the Denote file-naming scheme:
;;
;;   IDENTIFIER--TITLE__KEYWORD1_KEYWORD2.EXT
;;
;; The identifier may be long (YYYYMMDDTHHMMSS) or short (YYMMDD):
;;
;;   20240519T073456--my-note-title__emacs_coding.org
;;   240519--my-note-title__emacs_coding.org
;;
;; The format used when generating new identifiers is controlled by
;; `denotef-identifier-format'.  Existing identifiers in either
;; format are preserved on rename.
;;
;; This package extracts only the rename functionality from Denote,
;; without signatures or any other Denote features.

;;; Code:

(require 'dired)

;;;; Customization

(defgroup denotef nil
  "Rename files using the Denote file-naming scheme."
  :group 'files)

(defcustom denotef-prompts '(title keywords)
  "Which components to prompt for when renaming.
Available symbols: `title', `keywords', `date'."
  :type '(set (const :tag "Title" title)
              (const :tag "Keywords" keywords)
              (const :tag "Date" date))
  :group 'denotef)

(defcustom denotef-known-keywords nil
  "List of known keywords for completion."
  :type '(repeat string)
  :group 'denotef)

(defcustom denotef-save-buffers nil
  "When non-nil, save buffers after renaming."
  :type 'boolean
  :group 'denotef)

(defcustom denotef-after-rename-hook nil
  "Hook run after a file is renamed.
Each function receives the original and new file paths."
  :type 'hook
  :group 'denotef)

(defcustom denotef-identifier-format 'long
  "Format used when generating new identifiers.
`long' produces YYYYMMDDTHHMMSS; `short' produces YYMMDD.
Existing identifiers in either format are preserved on rename."
  :type '(choice (const :tag "Long YYYYMMDDTHHMMSS" long)
                 (const :tag "Short YYMMDD" short))
  :group 'denotef)

;;;; Identifier format

(defconst denotef--long-id-regexp
  "[0-9]\\{8\\}T[0-9]\\{6\\}"
  "Regexp matching a long Denote date identifier (YYYYMMDDTHHMMSS).")

(defconst denotef--short-id-regexp
  "[0-9]\\{6\\}"
  "Regexp matching a short Denote date identifier (YYMMDD).")

(defconst denotef--id-regexp
  (concat "\\(?:" denotef--long-id-regexp
          "\\|" denotef--short-id-regexp "\\)")
  "Regexp matching a Denote date identifier (long or short).")

(defconst denotef--file-regexp
  (concat "\\`\\(?1:" denotef--id-regexp "\\)"
          "\\(?:--\\(?2:[^_]*?\\)\\)?"
          "\\(?:__\\(?3:.*?\\)\\)?"
          "\\(?4:\\..*\\)\\'")
  "Regexp matching a Denote-style file name.
Groups: 1=identifier, 2=title, 3=keywords, 4=extension.")

;;;; Sluggification

(defun denotef--sluggify-title (str)
  "Make STR an appropriate slug for a title."
  (downcase
    (replace-regexp-in-string
     "^-\\|-$" ""
     (replace-regexp-in-string
      "-\\{2,\\}" "-"
      (replace-regexp-in-string
       "_\\|\\s-+" "-"
       (replace-regexp-in-string
        "[][{}!@#$%^&*()+'\"?,.|;:~`\u2018\u2019\u201c\u201d/=]*" "" str))))))

(defun denotef--sluggify-keyword (str)
  "Make STR an appropriate slug for a keyword."
  (downcase
    (replace-regexp-in-string
     "[][{}!@#$%^&*()+'\"?,.|;:~`\u2018\u2019\u201c\u201d/_ =-]*" "" str)))

;;;; Parsing

(defun denotef--parse-file-name (file)
  "Parse FILE name into (identifier title keywords extension).
Return nil if FILE does not match the Denote scheme."
  (let ((name (file-name-nondirectory file)))
    (when (string-match denotef--file-regexp name)
      (list (match-string 1 name)
            (match-string 2 name)
            (match-string 3 name)
            (match-string 4 name)))))

(defun denotef--extract-title (file)
  "Extract title from FILE name, or return empty string."
  (if-let ((parsed (denotef--parse-file-name file)))
      (or (nth 1 parsed) "")
    ""))

(defun denotef--extract-keywords (file)
  "Extract keywords list from FILE name."
  (if-let* ((parsed (denotef--parse-file-name file))
            (kw-str (nth 2 parsed)))
      (split-string kw-str "_" t)
    nil))

(defun denotef--extract-identifier (file)
  "Extract identifier from FILE name, or return nil."
  (if-let ((parsed (denotef--parse-file-name file)))
      (nth 0 parsed)
    nil))

;;;; File name construction

(defun denotef--format-file-name (dir identifier title keywords extension)
  "Construct a Denote-style file path.
DIR is the directory.  IDENTIFIER, TITLE are strings.
KEYWORDS is a list of strings.  EXTENSION includes the dot."
  (let* ((title-slug (if (and title (not (string-empty-p title)))
                         (concat "--" (denotef--sluggify-title title))
                       ""))
         (kw-slug (if keywords
                      (concat "__"
                              (mapconcat #'denotef--sluggify-keyword
                                         (sort (copy-sequence keywords) #'string<)
                                         "_"))
                    ""))
         (name (concat identifier title-slug kw-slug extension)))
    (expand-file-name name dir)))

;;;; Identifier generation

(defun denotef--file-creation-time (file)
  "Return the creation (birth) time of FILE.
On macOS use `stat -f %B' to get the birth time.  Fall back to
the modification time when birth time is unavailable."
  (or (and (eq system-type 'darwin)
           (file-exists-p file)
           (with-temp-buffer
             (when (zerop (call-process "stat" nil t nil "-f" "%B" file))
               (let ((s (string-trim (buffer-string))))
                 (when (string-match-p "\\`[0-9]+\\'" s)
                   (time-convert (string-to-number s) 'list))))))
      (file-attribute-modification-time (file-attributes file))))

(defun denotef--generate-identifier (&optional date format)
  "Generate a Denote date identifier from DATE or current time.
DATE can be a time value or a string parseable by `date-to-time'.
FORMAT is `long' (YYYYMMDDTHHMMSS) or `short' (YYMMDD); it
defaults to `denotef-identifier-format'."
  (let ((time (cond
               ((null date) (current-time))
               ((stringp date) (date-to-time date))
               (t date)))
        (fmt (or format denotef-identifier-format)))
    (format-time-string (if (eq fmt 'short) "%y%m%d" "%Y%m%dT%H%M%S")
                        time)))

;;;; Prompts

(defvar denotef--title-history nil
  "History list for title prompts.")

(defvar denotef--keywords-history nil
  "History list for keywords prompts.")

(defvar denotef--date-history nil
  "History list for date prompts.")

(defun denotef--title-prompt (&optional initial)
  "Prompt for a title with optional INITIAL value."
  (let ((title (read-string "Title: " initial 'denotef--title-history)))
    (if (string-empty-p title) "" title)))

(defun denotef--keywords-prompt (&optional initial)
  "Prompt for keywords with optional INITIAL value.
INITIAL is a list of strings."
  (let* ((initial-str (when initial (mapconcat #'identity initial ",")))
         (crm-separator ",")
         (input (completing-read-multiple
                 "Keywords: "
                 denotef-known-keywords
                 nil nil initial-str 'denotef--keywords-history)))
    (seq-remove #'string-empty-p input)))

(defun denotef--date-prompt (&optional initial)
  "Prompt for a date with optional INITIAL value."
  (read-string "Date (e.g. 2024-05-19 07:34): " initial 'denotef--date-history))

;;;; Core rename

(defun denotef--file-at-point-or-prompt ()
  "Return file at Dired point, current buffer file, or prompt."
  (cond
   ((derived-mode-p 'dired-mode)
    (dired-get-filename))
   (buffer-file-name
    buffer-file-name)
   (t
    (read-file-name "File to rename: "))))

(defun denotef--rename-file-and-buffer (old-path new-path)
  "Rename OLD-PATH to NEW-PATH, updating any visiting buffer."
  (unless (string= old-path new-path)
    (rename-file old-path new-path nil)
    (when-let ((buf (find-buffer-visiting old-path)))
      (with-current-buffer buf
        (set-visited-file-name new-path t t)
        (when denotef-save-buffers
          (save-buffer))))))

;;;###autoload
(defun denotef-rename-file (file)
  "Rename FILE using the Denote file-naming scheme.

Prompt for components based on `denotef-prompts' (default: title
and keywords).  If FILE already has a Denote identifier, keep it;
otherwise generate a new one.

In Dired, operate on the file at point.  Otherwise use the
current buffer's file, or prompt for one.

Shows old and new names and asks for confirmation before renaming."
  (interactive (list (denotef--file-at-point-or-prompt)))
  (let* ((file (expand-file-name file))
         (dir (file-name-directory file))
         (ext (let ((e (file-name-extension file t)))
                (if (string-empty-p e)
                    ""
                  e)))
         ;; Parse existing components
         (cur-id (denotef--extract-identifier file))
         (base-name (file-name-sans-extension (file-name-nondirectory file)))
         (cur-title (let ((raw (denotef--extract-title file)))
                      (if (string-empty-p raw)
                          (let ((part (if (string-match "__" base-name)
                                         (substring base-name 0 (match-beginning 0))
                                       base-name)))
                            (replace-regexp-in-string "[-_]" " " part))
                        (replace-regexp-in-string "-" " " raw))))
         (cur-keywords (or (denotef--extract-keywords file)
                           (when (string-match "__\\(.*\\)" base-name)
                             (split-string (match-string 1 base-name) "_" t))))
         ;; Prompt or keep
         (title (if (memq 'title denotef-prompts)
                    (denotef--title-prompt cur-title)
                  (or (nth 1 (denotef--parse-file-name file)) "")))
         (keywords (if (memq 'keywords denotef-prompts)
                       (denotef--keywords-prompt cur-keywords)
                     cur-keywords))
         (identifier
          (cond
           ((memq 'date denotef-prompts)
            (let ((input (denotef--date-prompt cur-id)))
              (if (string-match-p (concat "\\`" denotef--id-regexp "\\'") input)
                  input
                (denotef--generate-identifier input))))
           (cur-id cur-id)
           (t (denotef--generate-identifier
               (denotef--file-creation-time file)))))
         (new-path (denotef--format-file-name dir identifier title keywords ext)))
    (if (string= file new-path)
        (message "File name unchanged.")
      (when (yes-or-no-p
             (format "Rename\n  %s\nto\n  %s?"
                     (file-name-nondirectory file)
                     (file-name-nondirectory new-path)))
        (denotef--rename-file-and-buffer file new-path)
        (when (derived-mode-p 'dired-mode)
          (revert-buffer))
        (run-hook-with-args 'denotef-after-rename-hook file new-path)
        (message "Renamed to %s" (file-name-nondirectory new-path))))))

;;;###autoload
(defun denotef-rename-file-title ()
  "Rename file prompting only for title."
  (declare (interactive-only t))
  (interactive)
  (let ((denotef-prompts '(title)))
    (call-interactively #'denotef-rename-file)))

;;;###autoload
(defun denotef-rename-file-keywords ()
  "Rename file prompting only for keywords."
  (declare (interactive-only t))
  (interactive)
  (let ((denotef-prompts '(keywords)))
    (call-interactively #'denotef-rename-file)))

;;;###autoload
(defun denotef-rename-file-date ()
  "Rename file prompting only for date."
  (declare (interactive-only t))
  (interactive)
  (let ((denotef-prompts '(date)))
    (call-interactively #'denotef-rename-file)))

;;;; Dired fontification

(defgroup denotef-faces nil
  "Faces for Denotef in Dired."
  :group 'denotef)

(defface denotef-faces-date '((t :inherit font-lock-variable-name-face))
  "Face for the date part of the identifier."
  :group 'denotef-faces)

(defface denotef-faces-year '((t :inherit denotef-faces-date))
  "Face for the year in the identifier."
  :group 'denotef-faces)

(defface denotef-faces-month '((t :inherit denotef-faces-date))
  "Face for the month in the identifier."
  :group 'denotef-faces)

(defface denotef-faces-day '((t :inherit denotef-faces-date))
  "Face for the day in the identifier."
  :group 'denotef-faces)

(defface denotef-faces-hour '((t :inherit denotef-faces-date))
  "Face for the hour in the identifier."
  :group 'denotef-faces)

(defface denotef-faces-minute '((t :inherit denotef-faces-date))
  "Face for the minute in the identifier."
  :group 'denotef-faces)

(defface denotef-faces-second '((t :inherit denotef-faces-date))
  "Face for the second in the identifier."
  :group 'denotef-faces)

(defface denotef-faces-title nil
  "Face for the title component."
  :group 'denotef-faces)

(defface denotef-faces-keywords '((t :inherit font-lock-builtin-face))
  "Face for the keywords component."
  :group 'denotef-faces)

(defface denotef-faces-delimiter
  '((((class color) (min-colors 88) (background light))
     :foreground "gray70")
    (((class color) (min-colors 88) (background dark))
     :foreground "gray30")
    (t :inherit shadow))
  "Face for delimiters (-- and __)."
  :group 'denotef-faces)

(defface denotef-faces-extension '((t :inherit shadow))
  "Face for the file extension."
  :group 'denotef-faces)

(defun denotef--dired-file-name-matcher (limit)
  "Match a Denote-style file name in Dired, up to LIMIT."
  (let ((initial-point (point))
        (initial-match-data (match-data))
        (found nil))
    (while (and (not found) (< (point) limit))
      (if (and (dired-move-to-filename)
               (looking-at (concat "\\(" denotef--id-regexp "\\)"
                                   "\\(?:--[^/]*\\)?"
                                   "\\(?:__[^/]*\\)?"
                                   "\\.[^/]*$")))
          (setq found t)
        (forward-line 1)))
    (if found
        (let ((beg (match-beginning 0)))
          (goto-char (match-end 0))
          (set-match-data (list beg (match-end 0)))
          (point))
      (goto-char initial-point)
      (set-match-data initial-match-data)
      nil)))

(defun denotef--title-matcher (limit)
  "Match title component in a Dired line, up to LIMIT."
  (let ((initial-point (point))
        (initial-match-data (match-data)))
    (if (or (re-search-forward "--\\(?1:[^/]*?\\)\\(__\\|\\.\\)[^/]*$" limit t)
            (re-search-forward "--\\(?1:[^/]*\\)$" limit t))
        (progn
          (goto-char (match-end 1))
          (set-match-data (list (match-beginning 1) (match-end 1)))
          (point))
      (goto-char initial-point)
      (set-match-data initial-match-data)
      nil)))

(defun denotef--keywords-matcher (limit)
  "Match keywords component in a Dired line, up to LIMIT."
  (let ((initial-point (point))
        (initial-match-data (match-data)))
    (if (or (re-search-forward "__\\(?1:[^/]*?\\)\\(\\.\\)[^/]*$" limit t)
            (re-search-forward "__\\(?1:[^/]*\\)$" limit t))
        (progn
          (goto-char (match-end 1))
          (set-match-data (list (match-beginning 1) (match-end 1)))
          (point))
      (goto-char initial-point)
      (set-match-data initial-match-data)
      nil)))

(defconst denotef--font-lock-keywords
  `((denotef--dired-file-name-matcher
     ;; Identifier: YYYYMMDDTHHMMSS
     ("\\(?1:[0-9]\\{4\\}\\)\\(?2:[0-9]\\{2\\}\\)\\(?3:[0-9]\\{2\\}\\)\\(?7:T\\)\\(?4:[0-9]\\{2\\}\\)\\(?5:[0-9]\\{2\\}\\)\\(?6:[0-9]\\{2\\}\\)"
      (goto-char (match-beginning 0))
      (goto-char (match-end 0))
      (1 'denotef-faces-year nil t)
      (2 'denotef-faces-month nil t)
      (3 'denotef-faces-day nil t)
      (4 'denotef-faces-hour nil t)
      (5 'denotef-faces-minute nil t)
      (6 'denotef-faces-second nil t)
      (7 'denotef-faces-delimiter nil t))
     ;; Identifier: YYMMDD (only when not followed by Tdigits, i.e. not a long id)
     ("\\(?1:[0-9]\\{2\\}\\)\\(?2:[0-9]\\{2\\}\\)\\(?3:[0-9]\\{2\\}\\)\\(?:--\\|__\\|\\.\\)"
      (goto-char (match-beginning 0))
      (goto-char (match-end 0))
      (1 'denotef-faces-year nil t)
      (2 'denotef-faces-month nil t)
      (3 'denotef-faces-day nil t))
     ;; Title
     (denotef--title-matcher
      (goto-char (match-beginning 0))
      (goto-char (match-end 0))
      (0 'denotef-faces-title nil t))
     ;; Keywords
     (denotef--keywords-matcher
      (goto-char (match-beginning 0))
      (goto-char (match-end 0))
      (0 'denotef-faces-keywords nil t))
     ;; Delimiters
     ("\\(--\\|__\\)"
      (goto-char (match-beginning 0))
      (goto-char (match-end 0))
      (0 'denotef-faces-delimiter nil t))
     ;; Extension
     ("\\..*$"
      (goto-char (match-beginning 0))
      (goto-char (match-end 0))
      (0 'denotef-faces-extension nil t))))
  "Font-lock keywords for Denote-style file names in Dired.")

(declare-function wdired-change-to-wdired-mode "wdired")
(declare-function wdired-finish-edit "wdired")

;;;###autoload
(define-minor-mode denotef-dired-mode
  "Fontify Denote-style file names in Dired buffers."
  :global nil
  :group 'denotef
  (if denotef-dired-mode
      (progn
        (font-lock-add-keywords nil denotef--font-lock-keywords t)
        (advice-add #'wdired-change-to-wdired-mode :after
                    (lambda (&rest _) (font-lock-add-keywords nil denotef--font-lock-keywords t)))
        (advice-add #'wdired-finish-edit :after
                    (lambda (&rest _) (font-lock-add-keywords nil denotef--font-lock-keywords t))))
    (font-lock-remove-keywords nil denotef--font-lock-keywords))
  (font-lock-flush (point-min) (point-max)))

(provide 'denotef)
;;; denotef.el ends here