;;; org-gdocs.el --- Sync org-mode buffers with Google Docs -*- lexical-binding: t; -*-

;; Author: James Felix Black <j@tft.io>
;; Keywords: org, google, docs, comments
;; Package-Requires: ((emacs "29.1"))

;;; Commentary:

;; A thin Emacs shell over the `org-gdocs' command-line binary.  The binary owns
;; all logic — org projection, the Google client, comment anchoring, and every
;; file write; this package only saves the buffer, shells out, reads the binary's
;; s-expression result envelope with `read' (never JSON), reports it, and reloads
;; the buffer so the tool's edits appear.
;;
;; The binary is stateless: all sync state lives in the org file itself, in the
;; tool-owned `* GDOC_METADATA' subtree.  Because the body is preserved
;; byte-for-byte and only the end-of-file machine region changes, reverting the
;; buffer keeps point in place.
;;
;; Enable `org-gdocs-mode' in an org buffer and drive it from the keymap. The
;; prefix is `org-gdocs-prefix-key' (default "C-c g"; rebind it when it collides,
;; e.g. gptel also binds "C-c g"). Under the prefix:
;;
;;   s   dwim (publish, resolve, or fetch by buffer state)
;;   p   push   — publish the projection to the linked doc
;;   f   pull   — fetch reviewer comments into the file
;;   c   clean  — archive comments marked DONE
;;   o   open   — open the linked doc in a browser
;;   d   toggle client-side debug output
;;   j   jump between a comment and its section (either direction)
;;   r   reply  — insert a reply skeleton under the comment at point
;;   k   close  — mark the comment at point DONE (push resolves it)
;;   n / N   move to the next / previous comment

;;; Code:

(require 'org)

(defgroup org-gdocs nil
  "Sync org-mode buffers with Google Docs via the `org-gdocs' binary."
  :group 'org
  :prefix "org-gdocs-")

(defcustom org-gdocs-program "org-gdocs"
  "Name or path of the `org-gdocs' executable.
Resolved against `exec-path' when not absolute; never hard-code a path here."
  :type 'string
  :group 'org-gdocs)

(defcustom org-gdocs-debug nil
  "When non-nil, append each command's raw output to the `*org-gdocs*' buffer."
  :type 'boolean
  :group 'org-gdocs)

;; ── Binary invocation ───────────────────────────────────────────────────────

(defun org-gdocs--run (command with-file)
  "Run `org-gdocs' COMMAND and return its parsed s-expression result.
When WITH-FILE is non-nil the visited file is passed as the argument (and the
buffer is saved first).  Signals only on a transport failure (no output); a
domain error is returned as an `(error …)' envelope for the caller to handle."
  (when (and with-file (not (buffer-file-name)))
    (user-error "Buffer is not visiting a file"))
  (when with-file (save-buffer))
  (let ((args (if with-file (list command (buffer-file-name)) (list command)))
        (stdout (generate-new-buffer " *org-gdocs-stdout*")))
    (unwind-protect
        (let ((exit (apply #'call-process org-gdocs-program nil stdout nil args)))
          (with-current-buffer stdout
            (when org-gdocs-debug (org-gdocs--debug-show (buffer-string)))
            (when (zerop (buffer-size))
              (error "org-gdocs produced no output (exit %s)" exit))
            (goto-char (point-min))
            (read (current-buffer))))
      (kill-buffer stdout))))

(defun org-gdocs--debug-show (raw)
  "Append RAW binary output to the `*org-gdocs*' debug buffer."
  (with-current-buffer (get-buffer-create "*org-gdocs*")
    (goto-char (point-max))
    (insert raw (if (string-suffix-p "\n" raw) "" "\n"))))

(defun org-gdocs--field (key fields)
  "Value of the (KEY value) entry in FIELDS, or nil."
  (cadr (assq key fields)))

(defun org-gdocs--report (result reverts)
  "Report a parsed RESULT envelope; when REVERTS and ok, reload the buffer.
Returns the ok field alist, or signals a `user-error' on an `(error …)'."
  (pcase result
    (`(ok ,cmd . ,fields)
     (when reverts (org-gdocs--revert-preserving-point))
     (message "org-gdocs %s: %s" cmd (org-gdocs--summary cmd fields))
     fields)
    (`(error ,cmd ,msg)
     (user-error "org-gdocs %s failed: %s" cmd msg))
    (_ (error "org-gdocs: unrecognized result %S" result))))

(defun org-gdocs--revert-preserving-point ()
  "Reload the buffer from disk, keeping point (the body is preserved on disk)."
  (let ((pos (point)))
    (revert-buffer t t t)
    (goto-char (min pos (point-max)))))

(defun org-gdocs--summary (cmd fields)
  "A one-line human summary of an ok CMD result's FIELDS."
  (pcase cmd
    ('auth (format "token at %s" (org-gdocs--field 'token-path fields)))
    ('push (format "doc %s — %s elements, %s resolved%s"
                   (org-gdocs--field 'document-id fields)
                   (org-gdocs--field 'elements fields)
                   (length (org-gdocs--field 'resolved fields))
                   (if (eq (org-gdocs--field 'created fields) t) " (created)" "")))
    ('pull (format "doc %s — %s new of %s comments"
                   (org-gdocs--field 'document-id fields)
                   (org-gdocs--field 'new fields)
                   (org-gdocs--field 'total fields)))
    ('clean (format "%s archived" (org-gdocs--field 'removed fields)))
    ('open (org-gdocs--field 'url fields))
    (_ (format "%S" fields))))

;; ── Commands ────────────────────────────────────────────────────────────────

(defun org-gdocs-auth ()
  "Authenticate with Google via the OAuth loopback flow."
  (interactive)
  (org-gdocs--report (org-gdocs--run "auth" nil) nil))

(defun org-gdocs-push ()
  "Publish the buffer's projection to its linked Google Doc."
  (interactive)
  (org-gdocs--report (org-gdocs--run "push" t) t))

(defun org-gdocs-pull ()
  "Fetch reviewer comments from the linked doc into the buffer."
  (interactive)
  (org-gdocs--report (org-gdocs--run "pull" t) t))

(defun org-gdocs-clean ()
  "Archive the buffer's comments marked DONE."
  (interactive)
  (org-gdocs--report (org-gdocs--run "clean" t) t))

(defun org-gdocs-open-in-browser ()
  "Open the linked Google Doc in a browser."
  (interactive)
  (let ((fields (org-gdocs--report (org-gdocs--run "open" t) nil)))
    (browse-url (org-gdocs--field 'url fields))))

(defun org-gdocs-dwim ()
  "Do the obvious sync action for the buffer's state.
Unlinked → push (first publish); has a DONE comment → push (resolve it);
otherwise → pull (fetch new comments)."
  (interactive)
  (cond
   ((not (org-gdocs--linked-p)) (org-gdocs-push))
   ((org-gdocs--has-done-comment-p) (org-gdocs-push))
   (t (org-gdocs-pull))))

(defun org-gdocs-toggle-debug ()
  "Toggle client-side raw-output logging to `*org-gdocs*'."
  (interactive)
  (setq org-gdocs-debug (not org-gdocs-debug))
  (message "org-gdocs debug %s" (if org-gdocs-debug "on" "off")))

;; ── Comment navigation (no markers — search the body for the CUSTOM_ID) ──────

(defun org-gdocs-visit-comment-section ()
  "Jump from the comment heading at point to its anchored body section."
  (interactive)
  (let ((section (org-entry-get (point) "COMMENT_SECTION")))
    (cond
     ((null section) (user-error "No :COMMENT_SECTION: for the comment at point"))
     (t (let ((target (org-gdocs--find-custom-id section)))
          (if target (progn (goto-char target) (org-back-to-heading t) (recenter))
            (user-error "Section %s not found in the body" section)))))))

(defun org-gdocs--find-custom-id (id)
  "Position of the `:CUSTOM_ID: ID' drawer line in the body, or nil."
  (save-excursion
    (goto-char (point-min))
    (when (re-search-forward
           (format "^[ \t]*:CUSTOM_ID:[ \t]+%s[ \t]*$" (regexp-quote id)) nil t)
      (line-beginning-position))))

(defun org-gdocs-visit-comment ()
  "Jump from the body section at point to the comment anchored to it.
The reverse of `org-gdocs-visit-comment-section': finds the first comment whose
`:COMMENT_SECTION:' matches the `:CUSTOM_ID:' of the section enclosing point."
  (interactive)
  (let ((custom-id (org-entry-get (point) "CUSTOM_ID" t)))
    (unless custom-id (user-error "Point is not under a section with a :CUSTOM_ID:"))
    (let ((target (org-gdocs--find-comment-for-section custom-id)))
      (if target (progn (goto-char target) (org-back-to-heading t) (recenter))
        (user-error "No comment anchored to %s" custom-id)))))

(defun org-gdocs--find-comment-for-section (custom-id)
  "Position of the first comment heading whose :COMMENT_SECTION: is CUSTOM-ID."
  (save-excursion
    (goto-char (point-min))
    (when (re-search-forward
           (format "^[ \t]*:COMMENT_SECTION:[ \t]+%s[ \t]*$" (regexp-quote custom-id))
           nil t)
      (org-back-to-heading t)
      (point))))

(defun org-gdocs-jump ()
  "Jump between a comment and its section, depending on where point is.
On a comment heading, go to its anchored body section; anywhere in the body, go
to the comment anchored to the enclosing section."
  (interactive)
  (if (org-gdocs--comment-heading-position)
      (org-gdocs-visit-comment-section)
    (org-gdocs-visit-comment)))

;; ── Replying to and closing comments ─────────────────────────────────────────

(defun org-gdocs-reply ()
  "Insert a reply skeleton under the comment at point and position point to type.
The next `push' posts replies authored this way (one Drive reply per `REPLY'
subheading) and records them so they are never posted twice."
  (interactive)
  (let ((comment (org-gdocs--comment-heading-position)))
    (unless comment (user-error "Point is not within a comment"))
    (let ((level (save-excursion (goto-char comment) (org-current-level))))
      (goto-char comment)
      (org-end-of-subtree t t)
      (unless (bolp) (insert "\n"))
      (insert (make-string (1+ level) ?*) " REPLY\n")
      (save-excursion (insert "\n")))))

(defun org-gdocs-close-comment ()
  "Mark the comment at point DONE; the next `push' resolves it in Google."
  (interactive)
  (let ((comment (org-gdocs--comment-heading-position)))
    (unless comment (user-error "Point is not within a comment"))
    (save-excursion
      (goto-char comment)
      (org-todo "DONE")))
  (message "Comment closed; run push (C-c g p) to resolve it in Google"))

(defun org-gdocs--comment-heading-position ()
  "Position of the comment heading enclosing point (the one bearing a
`:COMMENT_ID:'), or nil when point is not within a comment subtree."
  (save-excursion
    (unless (org-before-first-heading-p)
      (org-back-to-heading t)
      (catch 'found
        (while t
          (when (org-entry-get (point) "COMMENT_ID")
            (throw 'found (point)))
          (unless (org-up-heading-safe)
            (throw 'found nil)))))))

(defun org-gdocs-next-comment ()
  "Move to the next `*** ' comment heading."
  (interactive)
  (org-gdocs--move-comment #'re-search-forward))

(defun org-gdocs-prev-comment ()
  "Move to the previous `*** ' comment heading."
  (interactive)
  (org-gdocs--move-comment #'re-search-backward))

(defun org-gdocs--move-comment (search)
  "Move point to the next comment heading found by SEARCH, or report none."
  (let ((origin (point)))
    (when (eq search #'re-search-forward) (end-of-line))
    (when (eq search #'re-search-backward) (beginning-of-line))
    (if (funcall search "^\\*\\*\\* " nil t)
        (beginning-of-line)
      (goto-char origin)
      (message "No further comments"))))

;; ── Buffer-state predicates (text inspection only; no Google logic) ──────────

(defun org-gdocs--linked-p ()
  "Non-nil when the buffer carries a `#+GDOC_ID:' keyword."
  (save-excursion
    (goto-char (point-min))
    (re-search-forward "^#\\+GDOC_ID:" nil t)))

(defun org-gdocs--has-done-comment-p ()
  "Non-nil when an Active Comments subtree holds a DONE comment heading."
  (save-excursion
    (goto-char (point-min))
    (and (re-search-forward "^\\*\\* Active Comments" nil t)
         (re-search-forward "^\\*\\*\\* DONE " nil t))))

;; ── Minor mode ──────────────────────────────────────────────────────────────

(defvar org-gdocs-command-map
  (let ((map (make-sparse-keymap)))
    (define-key map "s" #'org-gdocs-dwim)
    (define-key map "p" #'org-gdocs-push)
    (define-key map "f" #'org-gdocs-pull)
    (define-key map "c" #'org-gdocs-clean)
    (define-key map "o" #'org-gdocs-open-in-browser)
    (define-key map "d" #'org-gdocs-toggle-debug)
    (define-key map "j" #'org-gdocs-jump)
    (define-key map "r" #'org-gdocs-reply)
    (define-key map "k" #'org-gdocs-close-comment)
    (define-key map "n" #'org-gdocs-next-comment)
    (define-key map "N" #'org-gdocs-prev-comment)
    map)
  "Keymap of `org-gdocs' commands, bound under `org-gdocs-prefix-key'.")

(defvar org-gdocs-mode-map (make-sparse-keymap)
  "Keymap for `org-gdocs-mode'; `org-gdocs-command-map' under the prefix key.")

(defun org-gdocs--set-prefix-key (symbol value)
  "Bind `org-gdocs-command-map' under VALUE in `org-gdocs-mode-map'.
The `:set' function for `org-gdocs-prefix-key' (SYMBOL): clears the old prefix
binding and installs the new one so the change takes effect immediately."
  (when (boundp symbol)
    (define-key org-gdocs-mode-map (kbd (symbol-value symbol)) nil))
  (set-default symbol value)
  (define-key org-gdocs-mode-map (kbd value) org-gdocs-command-map))

(defcustom org-gdocs-prefix-key "C-c g"
  "Prefix key for `org-gdocs-command-map' in `org-gdocs-mode-map'.
A key-description string (as for `kbd'), e.g. \"C-c g\" or \"C-c d\". Set it with
`setopt' or `:custom' so the keymap is rebound; a plain `setq' will not take
effect. Rebind this when the default collides with another package (e.g. gptel
also uses \"C-c g\")."
  :type 'string
  :set #'org-gdocs--set-prefix-key
  :initialize #'custom-initialize-set
  :group 'org-gdocs)

;;;###autoload
(define-minor-mode org-gdocs-mode
  "Toggle syncing the current org buffer with its linked Google Doc.

A thin shell over the `org-gdocs' binary: all projection, anchoring, and Google
communication happen in the binary, which reads and writes this file directly."
  :lighter " GDoc"
  :keymap org-gdocs-mode-map)

(provide 'org-gdocs)
;;; org-gdocs.el ends here
