;;; vc-pijul.el --- VC backend for Pijul     -*- lexical-binding: t; -*-

;;; Copyright © 2021, 2024 Aleksandr Vityazev

;; Author: Aleksandr Vityazev <avityazev@disroot.org>
;; Keywords: vc tools
;; Homepage: https://nest.pijul.com/fd9a/vc-pijul
;; Version: 0.3
;; Package-Requires: ((emacs "29.1"))

;; 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 <https://www.gnu.org/licenses/>.

;;; Commentary:

;; This file contains a VC backend for the Pijul version
;; control system.
;;
;; Add it somewhere in your config.
;; (push 'Pijul vc-handled-backends)
;; (push '(Pijul . ".pijul") project-vc-backend-markers-alist)
;;
;; Implement the rest of the vc interface.  See the comment at the
;; beginning of vc.el.  The current status is:
;; ("??" means: "figure out what to do about it")
;;
;; FUNCTION NAME                                   STATUS
;; BACKEND PROPERTIES
;; * revision-granularity                          OK
;; - update-on-retrieve-tag                        OK
;; STATE-QUERYING FUNCTIONS
;; * registered (file)                             OK
;; * state (file)                                  OK
;; - dir-status-files (dir files uf)               OK
;; * working-revision (file)                       OK
;; * checkout-model (files)                        OK
;; - mode-line-string (file)                       OK
;; STATE-CHANGING FUNCTIONS
;; * create-repo ()                                OK
;; * register (files &optional _rev _comment)      OK
;; - responsible-p (file)                          OK
;; - receive-file (file rev)                       NOT NEEDED
;; - unregister (file)                             ??
;; * checkin (files comment &optional _rev)        OK
;; - checkin-patch (patch-string comment)          ??
;; * find-revision (file rev buffer)               ??
;; * checkout (file &optional rev)                 ??
;; * revert (file &optional contents-done)         OK
;; - merge-file (file rev1 rev2)                   ??
;; - merge-news (file)                             ??
;; - mark-resolved (files)                         ??
;; - steal-lock (file &optional revision)          ??
;; - clone (remote directory rev)                  OK
;; HISTORY FUNCTIONS
;; * print-log (files buffer &optional _shortlog _start-revision limit)   OK
;; * log-outgoing (buffer remote-location)         ??
;; * log-incoming (buffer remote-location)         ??
;; - log-search (buffer pattern)                   ??
;; - log-view-mode ()                              OK
;; - show-log-entry (revision)                     OK
;; - comment-history (file)                        ??
;; - update-changelog (files)                      ??
;; * diff (file &optional _rev1 rev2 buffer _async) OK
;; - revision-completion-table (files)             ??
;; - annotate-command (file buf &optional rev)     OK
;; - annotate-time ()                              OK
;; - annotate-current-time ()                      NOT NEEDED
;; - annotate-extract-revision-at-line ()          OK
;; TAG/BRANCH SYSTEM
;; - create-tag (dir name branchp)                 OK
;; - retrieve-tag (dir name update)                OK
;; MISCELLANEOUS
;; - make-version-backups-p (file)                 ??
;; - previous-revision (file-or-list rev)          OK
;; - next-revision (file-or-list rev)              OK
;; - file-name-changes (rev)                       ??
;; - check-headers ()                              ??
;; - delete-file (file)                            OK
;; - rename-file (old new)                         OK
;; - find-file-hook ()                             ??
;; - conflicted-files                              ??
;; - repository-url (file-or-dir)                  ??
;; - prepare-patch (rev)                           ??


;;; Code:
(require 'vc-dispatcher)
(require 'vc-hooks)
(require 'project)
(require 'map)
(require 'json)

(defgroup vc-pijul nil
  "The Pijul backend for vc."
  :prefix "vc-pijul-"
  :version "0.2"
  :group 'vc)

(defcustom vc-pijul-program "pijul"
  "Name of the Pijul executable (excluding any arguments)."
  :type 'string)

;; Clear up the cache to force vc-call to check again and discover
;; new functions when we reload this file.
(put 'Pijul 'vc-functions nil)

;;; BACKEND PROPERTIES
(defun vc-pijul-revision-granularity () 'repository)
(defun vc-pijul-checkout-model (_files) 'implicit)
(defun vc-pijul-update-on-retrieve-tag () nil)

(defun vc-pijul-root (file)
  "Return the root Pijul repository directory for FILE, or nil if not found."
  (vc-find-root file ".pijul"))

(defalias 'vc-pijul-find-root 'vc-pijul-root)
(defalias 'vc-pijul-responsible-p #'vc-pijul-root)

(defun vc-pijul-special-file-p (file)
  "Checking whether the FILE is special or not."
  (let ((file (expand-file-name file)))
    (and (string-match-p "/.pijul/" file)
         (not (string-match-p "/.pijul/config" file)))))

(defun vc-pijul-command (buffer okstatus file-or-list &rest flags)
  "Run Pijul COMMAND using VC-DO-COMMAND.
For BUFFER, OKSTATUS, FILE-OR-LIST and FLAGS see `vc-do-command' doc."
  (apply #'vc-do-command (or buffer "*vc*") okstatus
         vc-pijul-program file-or-list flags))

(defun vc-pijul--call (buffer command &rest args)
  (let ((inhibit-null-byte-detection t)
	(coding-system-for-read
         (or coding-system-for-read 'utf-8))
	(coding-system-for-write
         (or coding-system-for-write 'utf-8)))
    (apply #'process-file vc-pijul-program nil buffer nil command args)))

(defun vc-pijul--out-ok (command &rest args)
  "Run `pijul COMMAND ARGS...' and insert standard output in current buffer.
Return whether the process exited with status zero."
  (zerop (apply #'vc-pijul--call '(t nil) command args)))

(defun vc-pijul--out-str (command &rest args)
  "Run `pijul COMMAND ARGS...' and return standard output as a string.
The exit status is ignored."
  (with-output-to-string
    (with-current-buffer standard-output
      (apply #'vc-pijul--out-ok command args))))

(defun vc-pijul--out-json-read (command &rest args)
  "Run `pijul COMMAND ARGS...', read the JSON object and return it.
The exit status is ignored."
  (with-temp-buffer
    (apply #'vc-pijul--out-ok command "--output-format" "json" args)
    (goto-char (point-min))
    (json-read)))

(defun vc-pijul--out-match (args regexp group)
  "Run `pijul ARGS...' and return match for group number GROUP of REGEXP.
Return nil if the output does not match.  The exit status is ignored."
  (let ((out (apply #'vc-pijul--out-str args)))
    (when (string-match regexp out)
      (match-string group out))))

(defun vc-pijul--run-command-string (file &rest args)
  "Run a `pijul ARGS ...' command on FILE and return its output as string.
FILE can be nil."
  (let* ((ok t)
         (str (with-output-to-string
                (with-current-buffer standard-output
                  (unless (apply #'vc-pijul--out-ok
				 (if file
				     (append args (list (file-relative-name
							 file)))
				   args))
                    (setq ok nil))))))
    (and ok str)))

(defun vc-pijul--file-or-list-to-str (file-or-list)
  "Return the string of filenames from FILE-OR-LIST."
  (if (stringp file-or-list)
      file-or-list
    (string-join file-or-list " ")))

(defun vc-pijul-next-revision (file-or-list rev)
  "Return the next revision of REV for FILE-OR-LIST.
If there is no next revision return nil."
  (vc-pijul--out-match
   `("log" "--hash-only" "--"
     ,(vc-pijul--file-or-list-to-str file-or-list))
   (rx line-start
       (group (= 53 (any alnum))) "\n"
       (group (literal rev)))
   1))

(defun vc-pijul-previous-revision (file-or-list rev)
  "Return the previous revision of REV for FILE-OR-LIST.
If there is no previous revision return nil."
  (vc-pijul--out-match
   `("log" "--hash-only" "--"
     ,(vc-pijul--file-or-list-to-str file-or-list))
   (rx line-start
       (group (literal rev)) "\n"
       (group (= 53 (any alnum))))
   2))

;;;###autoload (defun vc-pijul-registered (file)
;;;###autoload   "Return non-nil if FILE is registered with pijul."
;;;###autoload   (if (vc-find-root file ".pijul")       ; Short cut.
;;;###autoload       (progn
;;;###autoload         (load "vc-pijul" nil t)
;;;###autoload         (vc-pijul-registered file))))

(defun vc-pijul-registered (file)
  "Return non-nil if FILE is handled by Pijul."
  (when-let* ((dir (vc-pijul-root file)))
    (unless (vc-pijul-special-file-p file)
      (with-temp-buffer
        (let* (process-file-side-effects
               (name (file-relative-name file dir))
               (str (with-demoted-errors "Error: %S"
                      (vc-pijul--out-ok "list" "--repository"
                                        (expand-file-name dir))
                      (buffer-string))))
          (and str (string-match-p
                    (rx line-start (literal name)) str)))))))

(defun vc-pijul--state-code (code)
  "Convert from a string CODE to an added/deleted/modified state."
  (pcase code
    ((or "A" "UD") 'added)
    ((or "D" "MV") 'removed)
    ((or "M" "R" "RZ" "SC") 'edited)
    ("U" 'unregistered)
    ("UC" 'conflict)
    (_ 'up-to-date)))

(defun vc-pijul-state (file)
  "Return the state of FILE."
  (when-let* ((dir (vc-pijul-root file)))
    (let* ((filename (file-relative-name file dir))
           (code (vc-pijul--out-match
                  `("diff" "--short" "--untracked")
                  (rx line-start
                      (group letter (opt letter))
                      " " (group (literal filename)))
                  1)))
      (vc-pijul--state-code code))))

(defun vc-pijul-default-remote (dir)
  "Get the remote repository locations, if any, for the current DIR.
The default remote will _probably_ be the first in the list."
  (let ((root (vc-pijul-root (expand-file-name dir))))
    (with-temp-buffer
      (insert-file-contents (expand-file-name ".pijul/config" root))
      (goto-char (point-min))
      (re-search-forward
       (rx line-start "default_remote" space "=" space "\""
           (group (zero-or-more not-newline)) "\"")
       nil nil)
      (match-string 1))))

(defun vc-pijul-current-channel ()
  "Return current channel."
  (vc-pijul--out-match
   `("channel")
   (rx line-start "*" space
       (group (zero-or-more alnum)))
   1))

(defun vc-pijul--header (header-name value)
  "Return string from HEADER-NAME and VALUE with text properties."
  (concat
   (propertize (format "%-11s: " header-name) 'face 'vc-dir-header)
   (propertize value 'face 'vc-dir-header-value)))

(defun vc-pijul-dir-extra-headers (dir)
  "Extra headers for DIR."
  (let ((default-directory dir))
    (string-join
     (list (vc-pijul--header "Channel" (vc-pijul-current-channel))
           (vc-pijul--header "Remote" (vc-pijul-default-remote dir)))
     "\n")))

(defun vc-pijul-register (file-or-list &optional _rev _comment)
  "Add FILE-OR-LIST to the Pijul repository.
REV and COMMENT are ignored."
  (vc-pijul-command nil 0 file-or-list "add"))

(defun vc-pijul-working-revision (file)
  "Return the working revision of FILE.
With Pijul, this is simply the hash of the last patch that touched this file."
  (when-let* ((dir (vc-pijul-root file)))
    (let ((hash (string-trim-right
                 (vc-pijul--out-str
                  "log" "--hash-only" "--limit" "1" "--"
                  (file-relative-name file dir)))))
      (or (and (not (string-empty-p hash)) hash) "0"))))

(defun vc-pijul-mode-line-string (file)
  "Return the mode line string to show for FILE."
  (let ((state (vc-state file 'Pijul))
        (backend (vc-backend file)))
    (if (eq state 'up-to-date)
        (symbol-name backend)
      (format "%s:%s" backend state))))

(defun vc-pijul-create-repo ()
  "Create a new Pijul repository."
  (vc-pijul-command nil 0 nil "init"))

(defun vc-pijul-find-ignore-file (file)
  "Return the Pijul ignore file that controls FILE."
  (expand-file-name ".ignore" (vc-pijul-root file)))

(declare-function log-edit-mode "log-edit" ())
(declare-function log-edit-extract-headers "log-edit" (headers string))
(declare-function log-edit--toggle-amend "log-edit" (last-msg-fn))

(defun vc-pijul-log-edit-toggle-amend ()
  "Toggle whether this will amend the previous commit.
If toggling on, also insert its message into the buffer."
  (interactive)
  (log-edit--toggle-amend
   (lambda ()
     (vc-pijul--out-match
      `("log" "--limit" "1")
      (rx line-start
          (= 4 whitespace)
          (group (one-or-more not-newline)))
      1))))

(defvar-keymap vc-pijul-log-edit-mode-map
  :name "Pijul-Log-Edit"
  "C-c C-e" #'vc-pijul-log-edit-toggle-amend)

(define-derived-mode vc-pijul-log-edit-mode log-edit-mode "Log-Edit/pijul"
  "Major mode for editing Pijul log messages.
It is based on `log-edit-mode', and has Pijul-specific extensions."
  (setq-local
   log-edit-font-lock-keywords
   (append log-edit-font-lock-keywords
           '((vc-git--log-edit-summary-check
	      (1 'vc-git-log-edit-summary-target-warning prepend t)
              (2 'vc-git-log-edit-summary-max-warning prepend t))))))

(defun vc-pijul-checkin (files comment &optional _rev)
  "Record FILES to Pijul.
COMMENT see `vc-checkin'.  REV is ignored."
  (pcase-let ((`(,description . ,args)
               (log-edit-extract-headers
                `(("Summary" . "--message")
                  ("Author" . "--author")
                  ("Date" . "--timestamp")
                  ("Identity" "--identity")
                  ("Amend" . ,(lambda (value)
                                (when (equal value "yes")
                                  (list "--amend")))))
                comment)))
    (apply #'vc-pijul-command nil 0
           (if (seq-contains-p args "--amend") nil files)
           "rec" `("--all" ,@args "--description" ,description))))

(defun vc-pijul-find-revision (_file _rev _buffer)
  "Fetch REVISION for FILE and put into BUFFER."
  (user-error "Not possible in the current version of Pijul 1.0 beta-9"))

(defun vc-pijul-checkout (_file &optional _rev)
  "Check out REVISION for FILE."
  (user-error "Not possible in the current version of Pijul 1.0 beta-9"))

(defun vc-pijul--pushpull (command prompt extra-args)
  "Run COMMAND (a string; either push or pull) on the current Pijul channel.
If PROMPT is non-nil, prompt for the Pijul command to run.
EXTRA-ARGS will be added to the command and must be a list of strings."
  (require 'vc-dispatcher)
  (let* ((root (vc-pijul-root default-directory))
	 (buffer (format "*vc-pijul : %s*" (expand-file-name root)))
         (pijul-program vc-pijul-program)
         ;; TODO if pushing, prompt if no default push location - cf bzr.
         (vc-filter-command-function
          (if prompt
              (lambda (&rest args)
                (pcase-let (((seq pijul _ `(,cmd . ,flags))
                             (apply #'vc-user-edit-command args)))
                  (setq pijul-program pijul
                        command cmd
                        extra-args flags)
                  args))
            vc-filter-command-function))
         (proc (apply #'vc-do-async-command
                      buffer root pijul-program command extra-args)))

    (with-current-buffer buffer
      (vc-run-delayed
        (vc-compilation-mode 'pijul)
        (setq-local compile-command
                    (concat pijul-program " " command " "
                            (mapconcat #'identity extra-args " ")))
        (setq-local compilation-directory root)
        ;; Either set `compilation-buffer-name-function' locally to nil
        ;; or use `compilation-arguments' to set `name-function'.
        ;; See `compilation-buffer-name'.
        (setq-local compilation-arguments
                    (list compile-command nil
                          (lambda (_name-of-mode) buffer)
                          nil))))
    (vc-set-async-update buffer)
    ;; Return the process for `vc-pull-and-push'
    proc))

(defun vc-pijul-push (prompt)
  "Pushes changes to a remote upstream.
If PROMPT is non-nil, prompt for the Pijul command to run."
  (vc-pijul--pushpull "push" prompt '("--all")))

(defun vc-pijul-pull (prompt)
  "Pulls changes from a remote upstream.
If PROMPT is non-nil, prompt for the Pijul command to run."
  (vc-pijul--pushpull "pull" prompt nil))

(defun vc-pijul-clone (remote directory rev)
  "Attempt to clone REMOTE repository into DIRECTORY at revision REV."
  (if (null rev)
      (vc-pijul--out-ok "clone" remote directory)
    (vc-pijul--out-ok "clone" "--state" rev remote directory))
  directory)

(defun vc-pijul-revert (file &optional contents-done)
  "Revert FILE back to the working revision.
If optional arg CONTENTS-DONE is non-nil, then the contents of FILE have
already been reverted from a version backup, and this function
only needs to update the status of FILE within the backend.
If FILE is in the `added' state it should be returned to the
`unregistered' state.

In other words, discards all unrecorded changes."
  (unless contents-done
    (if (eq (vc-state file) 'added)
        (vc-pijul-command nil 0 file "remove")
      (vc-pijul-command nil 0 file "reset"))))

(defun vc-pijul-log-unrecord (&optional reset)
  "Unrecords a list of selected changes from VC Pijul Log.
The changes will be removed from your log, but your working copy will
stay exactly the same, unless the RESET flag was passed with prefix
argument (\\[universal-argument])."
  (interactive "P")
  (let ((changes (log-view-get-marked))
        (arg (if reset "--reset" "")))
    (when (yes-or-no-p (format "Run 'pijul unrecord %s %s'?" arg changes))
      (if reset
          (apply #'vc-pijul-command nil 0 nil "unrecord" "--reset" changes)
        (apply #'vc-pijul-command nil 0 nil "unrecord" changes))
      (revert-buffer))))

(defvar-keymap vc-pijul-log-view-mode-map
  :name "Pijul-Log-View"
  "u" #'vc-pijul-log-unrecord)

(define-derived-mode vc-pijul-log-view-mode log-view-mode "Pijul-Log-View"
  (require 'add-log)
  (setq-local log-view-file-re nil)
  (setq-local log-view-per-file-logs nil)
  (setq-local log-view-message-re
              (rx line-start "Change" whitespace
                  (group (= 53 (any alnum)))))
  (setq-local log-view-font-lock-keywords
              `((,(rx line-start "Date: "
                      (group (one-or-more not-newline)))
                 (1 'change-log-date)))))

(defvar log-view-message-re)

(defun vc-pijul-show-log-entry (revision)
  "Move to the log entry for REVISION."
  (let ((last-change-hash (vc-pijul--out-match
                           `("log" "--limit" "1")
                           (rx line-start "Change" whitespace
                               (group (= 53 (any alnum))))
                           1)))
    (when (equal revision last-change-hash)
      (goto-char (point-min))
      (re-search-forward log-view-message-re)
      (beginning-of-line))))

(defun vc-pijul-print-log (files &optional buffer _shortlog _start-revision limit)
  "Print commit log associated with FILES into specified BUFFER.
LIMIT is a number that specifies the maximum number of entries to display."
  (let ((files (pcase-let ((`(,file . ,rest) files))
                 (unless (and (not rest)
                              (string-equal file (vc-pijul-root file)))
                   files))))
    (apply #'vc-pijul-command
           buffer 'async files "log" "--state"
           (append
            (and limit (list "--limit" (format "%d" limit)))
            (and files (list "--"))))))

(defun vc-pijul-diff (files &optional _rev1 rev2 buffer _async)
  "Shows difference in FILES between two channels/changes REV1 and REV2.
The output will be displayed in a buffer named BUFFER if specified,
or in *vc-pijul-diff*."
  (let ((buffer (or buffer "*vc-pijul-diff*")))
    (if (null rev2)
        (vc-pijul-command buffer 0 files "diff")
      (vc-pijul-command buffer 0 nil "change" rev2))))

(defun vc-pijul-rename-file (old new)
  "Rename file OLD to NEW in the Pijul repository."
  (vc-pijul-command nil 0 (list old new) "move"))

(defun vc-pijul-delete-file (file)
  "Removes a FILE from the tree of tracked files."
  (vc-pijul-command nil 0 file "remove"))

(defun vc-pijul-create-tag (dir name branchp)
  "Create a new, empty channel NAME.
Run this command in the DIR."
  (let ((default-directory dir))
    ;; FIXME: The tag cannot be created in an empty channel either.
    (and (or (string-empty-p (vc-pijul--out-str "diff"))
             (user-error (format "Can't create %s with modified files"
                                 (if branchp "branch" "tag"))))
         (if branchp
             (vc-pijul-command nil 0 nil "channel" "new" name)
           (vc-pijul-command nil 0 nil "tag" "create" name)))))

(defun vc-pijul-retrieve-tag (dir name _update)
  "Switch to a channel NAME.
Run this command in the DIR.  There must not be unrecorded
changes in the working copy"
  (let ((default-directory dir))
    (vc-pijul-command nil 0 nil "channel" "switch" name)))

(defun vc-pijul-dir-status-files (dir files update-function)
  "Return a list of (FILE STATE EXTRA) entries for FILES in DIR.
For UPDATE-FUNCTION see vc.el comment section."
  (let ((root (vc-pijul-root (expand-file-name dir))))
    (vc-pijul-command t 'async files "diff" "--short" "--untracked")
    (vc-exec-after
     `(vc-pijul-after-dir-status ',root ',update-function ',files))))

(defun vc-pijul--file-state (root file status)
  "Return (list FILE STATUS nil) if FILE is not directory in ROOT."
  (declare (indent 1))
  (let ((path (file-relative-name (expand-file-name file root))))
    (unless (file-directory-p path)
      (list path status nil))))

(defun vc-pijul-after-dir-status (root update-function _files)
  "Function to run when the `vc-dir' buffer’s process is done.
For UPDATE-FUNCTION see vc.el comment section."
  (let* (result registered-and-not-up-to-date-files)
    (goto-char (point-min))
    (while (not (eobp))
      (when (looking-at (rx (group (one-or-more (any "A-Z")))
                            (one-or-more space)
                            (group (one-or-more not-newline))))
        (when-let* ((file (match-string 2))
                    (state (match-string 1))
                    (file-state (vc-pijul--file-state root
                                  file (vc-pijul--state-code state))))
          (unless (seq-contains-p registered-and-not-up-to-date-files file)
            (push file-state result)
            (push file registered-and-not-up-to-date-files))))
      (forward-line))
    (funcall update-function (nreverse result) nil)))

(declare-function iso8601-parse "iso8601" (string &optional form))

(defun vc-pijul--decode-time (timestamp)
  "Convert TIMESTAMP to list of floating-point number of days and `decode-time'."
  (let ((decoded (iso8601-parse timestamp)))
    (cons (vc-annotate-convert-time (encode-time decoded)) decoded)))

(defvar vc-pijul-headers-cache (make-hash-table :test 'equal)
  "Cache of change headers.")

(defun vc-pijul-change-headers (rev)
  "Returns headers alist for the change with the REV hash."
  (if-let* ((headers (gethash rev vc-pijul-headers-cache)))
      headers
    (with-temp-buffer
      (vc-pijul-command t 0 nil "change" rev)
      (goto-char (point-min))
      (while (not (eobp))
        (when (looking-at
               (rx (group (zero-or-more not-newline)) " = '"
                   (group (zero-or-more not-newline)) "'"))
          (when-let* ((key (match-string 1)))
            (push (cons (intern key) (match-string 2)) headers)))
        (forward-line))
      (push (cons 'author "MeNotMe") headers)
      (puthash rev headers vc-pijul-headers-cache)
      headers)))

(defun vc-pijul--parse-credit (file)
  "Parse annotation for FILE and return alist ((rev . line) ...)."
  (with-temp-buffer
    (vc-pijul-command t 0 file "credit")
    (let (current-hash alist)
      (goto-char (point-min))
      (while (not (eobp))
        (cond ((looking-at (rx line-start
                               (group (one-or-more (any "0-9A-Z")))
                               (zero-or-more ", " (one-or-more (any "0-9A-Z")))
                               line-end))
               (setq current-hash (match-string 1)))
              ((looking-at (rx line-start "> "
                               (group (zero-or-more not-newline))
                               line-end))
               (push (cons current-hash (match-string 1)) alist)))
        (forward-line 1))
      (nreverse alist))))

(defun vc-pijul--insert-annotation (rev author timestamp line)
  "Insert annotation into current buffer.
Annotation: REV AUTHOR TIMESTAMP LINE."
  (pcase-let ((now (vc-annotate-convert-time))
              (`(,f-days ,sec ,min ,hour ,day ,month ,year)
               (vc-pijul--decode-time timestamp))
              (start (point)))
    (insert (format "%-12s " rev))
    (insert (format "%-7s "
                    (if (> (length author) 7)
                        (substring author 0 7)
                      author)))
    (insert
     (if (> (- now f-days) 0.9)
         (format "%s-%s-%s " year month day)
       (format "%s:%s:%s " hour min sec)))
    (insert line)
    (insert "\n")
    (add-text-properties
     start (point)
     (list 'vc-pijul-annotate (cons rev f-days)))))

(declare-function vc-annotate-convert-time "vc-annotate" (&optional time))

(defun vc-pijul-annotate-command (file buffer &optional _rev)
  "Produce an annotated display of FILE in BUFFER.
For Pijul, hashes and times are stored in text properties."
  (vc-setup-buffer buffer)
  (let* ((credit-alist (vc-pijul--parse-credit file)))
    (with-current-buffer buffer
      (dolist (annotation credit-alist)
        (pcase-let* ((`(,rev . ,line) annotation)
                     ((map ('author author) ('timestamp timestamp))
                      (vc-pijul-change-headers rev)))
          (vc-pijul--insert-annotation rev author timestamp line)))
      (clrhash vc-pijul-headers-cache))))

(defun vc-pijul-annotate-extract-revision-at-line ()
  "Extract revision at line."
  (pcase (get-text-property
          (point) 'vc-pijul-annotate (current-buffer))
    (`(,rev . ,_) rev)))

(defun vc-pijul-annotate-time ()
  "Extract time at line."
  (let ((prop (get-text-property
               (point) 'vc-pijul-annotate (current-buffer))))
    (re-search-forward
     (rx (= 2 digit) "." (= 2 digit) "." (= 4 digit) space) nil t)
    (pcase prop
      (`(,_ . ,f-days) f-days))))




(provide 'vc-pijul)
;;; vc-pijul.el ends here