;;; clutch.el --- Interactive database client -*- lexical-binding: t; -*-
;; Copyright (C) 2025-2026 Lucius Chen
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Author: Lucius Chen <chenyh572@gmail.com>
;; Assisted-by: OpenAI Codex:gpt-5.5
;; Maintainer: Lucius Chen <chenyh572@gmail.com>
;; Package-Version: 0.2.4
;; Package-Revision: a4dfac80ebbf
;; Package-Requires: ((emacs "29.1") (transient "0.3.7"))
;; Keywords: comm, data, tools
;; URL: https://github.com/LuciusChen/clutch
;; This file is part of clutch.
;; clutch 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.

;; clutch 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 clutch.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; Interactive database client with native and JDBC backends.
;;
;; Provides:
;; - `clutch-mode': SQL editing major mode (derived from `sql-mode')
;; - `clutch-repl': REPL via `comint-mode'
;; - Query execution with horizontally scrollable result tables
;; - Object discovery and completion
;;
;; Entry points:
;;   M-x clutch-mode      — open a SQL editing buffer
;;   M-x clutch-repl      — open a REPL
;;   Open a .mysql file   — activates clutch-mode automatically

;;; Code:

(require 'clutch-backend)
(require 'clutch-connection)
(require 'clutch-query)
(require 'sql)
(require 'comint)
(require 'cl-lib)

(defvar embark-general-map)
(defvar embark-target-finders)
(defvar embark-keymap-alist)
(require 'transient)
(require 'clutch-schema)
(require 'clutch-sql)
(require 'clutch-ui)
(require 'clutch-object)
(require 'clutch-edit)
(require 'clutch-result)
(require 'xref)

;;;; Customization

(defgroup clutch nil
  "Interactive database lens."
  :group 'comm
  :prefix "clutch-")

(defface clutch-field-name-face
  '((((class color) (background light))
     :weight bold :foreground "#2563eb")
    (((class color) (background dark))
     :weight bold :foreground "#b8d7ec")
    (t :weight bold))
  "Face for database field and column names."
  :group 'clutch)

(defface clutch-header-face
  '((t :weight bold))
  "Face for header text that is not a database field name."
  :group 'clutch)

(defface clutch-key-hint-key-face
  '((t :inherit transient-key))
  "Face for shortcut keys shown in Clutch header-line hints."
  :group 'clutch)

(defface clutch-key-hint-description-face
  '((t :inherit header-line))
  "Face for shortcut descriptions shown in Clutch header-line hints."
  :group 'clutch)

(defface clutch-insert-field-tag-face
  '((t :inherit shadow))
  "Face for metadata tags in the insert buffer."
  :group 'clutch)

(defface clutch-insert-field-error-face
  '((((class color) (background light))
     :underline (:color "#b91c1c" :style wave))
    (((class color) (background dark))
     :underline (:color "#fca5a5" :style wave))
    (t :inherit error))
  "Face for invalid values in the insert buffer."
  :group 'clutch)

(defface clutch-insert-inline-error-face
  '((t :inherit error))
  "Face for inline `insert-buffer' validation messages."
  :group 'clutch)

(defface clutch-insert-active-field-face
  '((t :inherit hl-line))
  "Face for the active line in the insert buffer."
  :group 'clutch)

(defface clutch-insert-active-field-name-face
  '((((class color) (background light))
     :weight bold :foreground "#2563eb")
    (((class color) (background dark))
     :weight bold :foreground "#b8d7ec")
    (t :weight bold))
  "Face for the active `insert-buffer' field prefix."
  :group 'clutch)

(defface clutch-header-active-face
  '((((class color) (background light))
     :background "#e5e7eb" :weight bold)
    (((class color) (background dark))
     :background "#263238" :weight bold)
    (t :weight bold))
  "Face for the column header under the cursor."
  :group 'clutch)

(defface clutch-border-face
  '((t :inherit shadow))
  "Face for table borders (pipes and separators)."
  :group 'clutch)

(defface clutch-object-source-face
  '((t :inherit shadow))
  "Face for object-source annotations in minibuffer completions."
  :group 'clutch)

(defface clutch-object-public-source-face
  '((t :inherit shadow))
  "Face for PUBLIC object-source annotations in minibuffer completions."
  :group 'clutch)

(defface clutch-object-type-face
  '((t :inherit shadow))
  "Face for object-type annotations in minibuffer completions."
  :group 'clutch)

(defface clutch-null-face
  '((t :inherit shadow :slant italic))
  "Face for NULL values."
  :group 'clutch)

(defconst clutch--cell-generated-placeholder :clutch-generated-placeholder
  "Sentinel for values generated by the database at insert time.")

(defconst clutch--cell-default-placeholder :clutch-default-placeholder
  "Sentinel for values populated by database defaults at insert time.")

(defface clutch-modified-face
  '((((class color) (background light))
     :inherit warning :background "#fff3cd")
    (((class color) (background dark))
     :inherit warning :background "#3d2b00")
    (t :inherit warning))
  "Face for staged-edit cell values."
  :group 'clutch)

(defface clutch-fk-face
  '((t :inherit font-lock-type-face :underline t))
  "Face for foreign key column values.
Underlined to indicate clickable (RET to follow)."
  :group 'clutch)

(defface clutch-marked-face
  '((t :inherit dired-marked))
  "Face for marked rows in result buffer."
  :group 'clutch)

(defface clutch-executed-sql-marker-face
  '((t :inherit success))
  "Face for the executed SQL gutter marker."
  :group 'clutch)

(defface clutch-failed-sql-marker-face
  '((t :inherit error))
  "Face for the failed SQL gutter marker."
  :group 'clutch)

(define-fringe-bitmap 'clutch-executed-sql-dot
  [24 60 126 255 255 126 60 24]
  nil nil 'center)

(defface clutch-pending-delete-face
  '((((class color) (background light))
     :background "#fde8e8" :foreground "#9b1c1c" :strike-through t)
    (((class color) (background dark))
     :background "#3b1212" :foreground "#fca5a5" :strike-through t)
    (t :strike-through t))
  "Face for rows staged for deletion."
  :group 'clutch)

(defface clutch-pending-insert-face
  '((((class color) (background light))
     :background "#e6f4ea" :foreground "#1e4620")
    (((class color) (background dark))
     :background "#1a3320" :foreground "#86efac")
    (t :inherit success))
  "Face for rows staged for insertion."
  :group 'clutch)

(defface clutch-error-summary-face
  '((((class color) (background dark)) :foreground "#ffb4b4" :weight semibold)
    (((class color) (background light)) :foreground "#b42318" :weight semibold)
    (t :inherit error :weight bold))
  "Face for SQL execution error summaries."
  :group 'clutch)

(defcustom clutch-connection-alist nil
  "Alist of saved database connections.
Each entry has the form:
  (NAME . (:host H :port P :user U [:password P] :database D
           [:backend SYM] [:sql-product SYM]
           [:profile-entry STR] [:pass-entry STR]
           [:ssh-host SSH-HOST] [:ssh-tunnel MODE]
           [:tramp TRAMP-DIRECTORY]
           [:url STR] [:display-name STR] [:props ALIST]
           [:tls BOOLEAN] [:ssl-mode disabled] [:sslmode require]
           [:connect-timeout N] [:read-idle-timeout N]
           [:query-timeout N] [:rpc-timeout N]))
NAME is a string used for `completing-read'.
:backend is required and names the backend symbol (\\='mysql, \\='pg,
\\='sqlite, \\='mongodb, or a JDBC backend such as \\='oracle or
\\='sqlserver).
:surface selects a non-default surface for backends that expose more than one
query language.  For MongoDB, omit it for the normal document/MongoDB Shell
surface, or use \\='sql-interface for MongoDB SQL Interface JDBC endpoints.
:sql-product overrides `clutch-sql-product' for this connection.
:auth-database / :auth-source set the MongoDB authentication database for
native MongoDB URLs and the default auth database in structured
MongoDB SQL Interface JDBC URLs.
:tls is a convenience shortcut for backend TLS defaults.  For MySQL,
an explicit `:tls nil' forces plaintext and suppresses the automatic
MySQL 8 TLS retry path; for PostgreSQL, `:tls t' maps to `:sslmode require'
and `:tls nil' maps to `:sslmode disable'.
:ssl-mode is currently MySQL-only; `disabled' is a compatibility spelling for
the same explicit plaintext mode.  The older alias `off' is also accepted.
:sslmode is PostgreSQL-only and follows the upstream naming.  Supported values
are `disable', `prefer', `require', and `verify-full'.
:ssh-host enables a local SSH tunnel using the named host from ~/.ssh/config.
clutch starts `ssh -N -L ... SSH-HOST' automatically, so this currently
requires structured `:host' / `:port' params and does not apply to `:url'
based JDBC entries.
:ssh-tunnel controls when that tunnel is used.  The default `always'
preserves the explicit tunnel behavior; `direct-first' probes `:host' / `:port'
briefly and skips the tunnel when the database endpoint is already reachable.
:tramp enables the same local forward from an ssh-like TRAMP directory such as
/ssh:host:/path/ or /rpc:host:/path/.  `:tramp-default-directory' is also
accepted as a longer spelling.
:profile-entry reads missing connection fields from an encrypted profile in
pass or .authinfo/.authinfo.gpg.  For pass, use the normal first-line password
and `key: value' fields such as `backend:', `host:', `port:', `user:',
`database:', `ssh-host:', and `ssh-tunnel:'.  For .authinfo, the `machine'
value is the profile id; use `db-host' for the real database host.  Profile
fields are defaults: explicit fields in `clutch-connection-alist' override
profile fields, including :backend, :host, :port, :user, :database, and
transport keys.  Keeping non-sensitive hints such as :backend in this alist lets
completion show backend icons without decrypting profiles for display.  If
:backend is omitted here, the profile must provide it before connecting.

Password resolution order:
  1. :password — used as-is when present.
  2. :profile-entry — uses the profile's first-line/`password' secret when no
     explicit :password or :pass-entry is configured.
  3. Pass store by connection name — when `auth-source-pass' is loaded,
     clutch automatically looks up a pass entry whose name matches NAME
     (the car of this alist entry).  The password is on the first line.
     Use :pass-entry STR to override the entry name if it differs.
  4. `auth-source-search' — searches ~/.authinfo / ~/.authinfo.gpg / pass
     by :host, :user, and :port (standard auth-source matching)."
  :type '(alist :key-type string
                :value-type (plist :options
                                   ((:host string)
                                    (:port integer)
                                    (:user string)
                                    (:password string)
                                    (:database string)
                                    (:auth-database string)
                                    (:auth-source string)
                                    (:backend symbol)
                                    (:sql-product symbol)
                                    (:profile-entry string)
                                    (:pass-entry string)
                                    (:ssh-host string)
                                    (:ssh-tunnel
                                     (choice (const always)
                                             (const direct-first)))
                                    (:tramp string)
                                    (:tramp-default-directory string)
                                    (:url string)
                                    (:display-name string)
                                    (:props (alist :key-type string :value-type string))
                                    (:ssl-mode (choice (const :tag "Disabled" disabled)
                                                       (const :tag "Off (alias)" off)))
                                    (:sslmode (choice (const :tag "Disable" disable)
                                                      (const :tag "Prefer" prefer)
                                                      (const :tag "Require" require)
                                                      (const :tag "Verify Full" verify-full)))
                                    (:connect-timeout natnum)
                                    (:read-idle-timeout natnum)
                                    (:query-timeout natnum)
                                    (:rpc-timeout natnum)
                                    (:tls boolean))))
  :group 'clutch)

(defcustom clutch-insert-validation-idle-delay 0.2
  "Idle seconds before validating heavier insert fields such as JSON."
  :type 'number
  :group 'clutch)

(defcustom clutch-console-directory
  (expand-file-name "clutch" user-emacs-directory)
  "Directory for persisting query console buffer content."
  :type 'directory
  :group 'clutch)

(defcustom clutch-result-window-height 0.33
  "Height of the result window as a fraction of the frame height.
A float between 0.0 and 1.0.  Only applies when creating a new result
window; an existing result window is reused at its current height."
  :type 'float
  :group 'clutch)

(defcustom clutch-result-max-rows 500
  "Maximum number of rows to display in result tables."
  :type 'natnum
  :group 'clutch)

(defcustom clutch-agent-context-max-result-rows 20
  "Maximum number of current result rows copied for external agent context."
  :type 'natnum
  :group 'clutch)

(defcustom clutch-agent-context-max-cell-width 200
  "Maximum width of a single copied cell in external agent context."
  :type 'natnum
  :group 'clutch)

(defcustom clutch-column-width-max 30
  "Maximum display width for a single column in the result table."
  :type 'natnum
  :group 'clutch)

(defcustom clutch-column-width-step 2
  "Step size for widening/narrowing columns with +/-."
  :type 'natnum
  :group 'clutch)

(defcustom clutch-column-padding 1
  "Number of padding spaces on each side of a cell."
  :type 'natnum
  :group 'clutch)

(defcustom clutch-sql-product 'mysql
  "SQL product used for syntax highlighting.
Must be a symbol recognized by `sql-mode' (e.g. mysql, postgres)."
  :type '(choice (const :tag "MySQL" mysql)
                 (const :tag "PostgreSQL" postgres)
                 (const :tag "MariaDB" mariadb)
                 (symbol :tag "Other"))
  :group 'clutch)

(defcustom clutch-connect-timeout-seconds 10
  "Timeout in seconds for establishing a database connection.
Applies to networked backends.  SQLite ignores this setting."
  :type 'natnum
  :group 'clutch)

(defcustom clutch-tramp-context-policy 'ask
  "How connection commands use the current TRAMP buffer context.
When nil, Clutch never infers TRAMP transport from the current buffer.
When `ask', Clutch prompts before using the current TRAMP default directory.
When `auto', Clutch uses the current TRAMP default directory without asking.
This only applies when a connection has no explicit transport such as
:ssh-host or :tramp.  TRAMP transport currently supports ssh-like TRAMP
directories.  `:tramp-default-directory' remains accepted as a longer spelling
for `:tramp'."
  :type '(choice (const :tag "Never infer TRAMP context" nil)
                 (const :tag "Ask before using current TRAMP context" ask)
                 (const :tag "Automatically use current TRAMP context" auto))
  :group 'clutch)

(defcustom clutch-read-idle-timeout-seconds 30
  "Idle timeout in seconds while waiting for query I/O.
Applies to MySQL, PostgreSQL, and JDBC network I/O.  SQLite ignores this
setting."
  :type 'natnum
  :group 'clutch)

(defcustom clutch-query-timeout-seconds 30
  "Timeout in seconds for database-side query execution.
Currently applied by PostgreSQL and JDBC.  Native MySQL does not yet enforce a
server-side statement timeout."
  :type 'natnum
  :group 'clutch)

(defcustom clutch-jdbc-rpc-timeout-seconds 30
  "Timeout in seconds for round-trips to the JDBC agent process."
  :type 'natnum
  :group 'clutch)

(defcustom clutch-object-warmup-idle-delay-seconds 0.5
  "Idle delay before warming non-table object metadata.
A small non-zero delay keeps connect and initial UI painting responsive before
background object discovery starts."
  :type 'number
  :group 'clutch)

(defcustom clutch-schema-refresh-idle-delay-seconds 0.5
  "Idle delay before automatic schema cache refresh after connect.
A small non-zero delay keeps the first query responsive for native backends
whose schema refresh runs on the foreground connection.  Manual schema
refresh commands still start immediately."
  :type 'number
  :group 'clutch)

(defcustom clutch-primary-object-types '("TABLE" "VIEW" "SYNONYM" "COLLECTION" "KEY")
  "Object types preferred by clutch's primary object entrypoint.
When nil, the primary entrypoint includes all schema object types."
  :type '(repeat string)
  :group 'clutch)

(defcustom clutch-sql-completion-case-style 'preserve
  "How SQL completion inserts keywords and identifiers.
`preserve' keeps backend-provided identifier case and uppercase SQL keywords.
`lower' inserts lowercase keywords and lowercases completion identifiers.
`upper' inserts uppercase keywords and uppercases completion identifiers."
  :type '(choice (const :tag "Preserve backend / default keyword case" preserve)
                 (const :tag "Lowercase keywords and identifiers" lower)
                 (const :tag "Uppercase keywords and identifiers" upper))
  :group 'clutch)

(defcustom clutch-schema-cache-install-batch-size 500
  "Maximum number of schema entries to install per idle slice.
Large schema snapshots are installed incrementally to keep Emacs responsive
after async metadata refreshes."
  :type 'natnum
  :group 'clutch)

(defcustom clutch-csv-export-default-coding-system 'utf-8-with-signature
  "Default coding system when exporting CSV files."
  :type '(choice (const :tag "UTF-8 (with BOM)" utf-8-with-signature)
                 (const :tag "UTF-8" utf-8)
                 (const :tag "GBK" gbk)
                 (coding-system :tag "Other coding system"))
  :group 'clutch)

(defcustom clutch-debug-event-limit 25
  "Maximum number of recent debug events kept per buffer or connection.
Only recorded while `clutch-debug-mode' is enabled."
  :type 'natnum
  :group 'clutch)

(defcustom clutch-console-yank-cleanup t
  "When non-nil, clean whitespace in pasted text in query consoles.
After `yank', `yank-pop', or `clipboard-yank' in a query console buffer,
trailing whitespace, mixed indentation, and CRLF line endings are
cleaned up in the pasted region only."
  :type 'boolean
  :group 'clutch)

(defconst clutch-debug-buffer-name "*clutch-debug*"
  "Name of the dedicated clutch debug buffer.")

;;;; Buffer-local variables

(defvar-local clutch-connection nil
  "Current database connection for this buffer.")

(defvar clutch-debug-mode nil
  "Non-nil when Clutch debug capture is enabled.")

(defvar clutch--source-window nil
  "Window that initiated the current query execution.
Dynamically bound by `clutch--execute' so result buffers open
adjacent to the correct console window.")

(defvar clutch--executing-sql-start nil
  "Buffer position where the currently executing SQL begins, or nil.
Dynamically bound by `clutch--execute-and-mark'.")

(defvar clutch--executing-sql-end nil
  "Buffer position where the currently executing SQL ends, or nil.
Dynamically bound by `clutch--execute-and-mark'.")

(defvar-local clutch--conn-sql-product nil
  "SQL product for the current connection, or nil to use the default.")

(defvar-local clutch--last-query nil
  "Last executed SQL query string.")

(defvar-local clutch--last-result-buffer nil
  "Latest result buffer produced from this query source buffer.")

;;;###autoload
(define-minor-mode clutch-debug-mode
  "Capture additional redacted troubleshooting data for clutch workflows.
When enabled, clutch records a bounded recent-event trace per buffer and per
connection.  JDBC requests also ask the agent for an optional debug payload,
and captured output is appended to the dedicated `*clutch-debug*' buffer."
  :global t
  :group 'clutch
  :lighter " ClutchDbg"
  (when clutch-debug-mode
    (clutch--clear-debug-capture)
    (clutch--replay-problem-records-to-debug-buffer)))

(defvar-local clutch--base-query nil
  "The original unfiltered SQL query, used by WHERE filtering.")

(defvar-local clutch--connection-params nil
  "Params plist used to establish the current connection.
Stored at connect time so the connection can be re-established
automatically when it drops.")

(defun clutch--update-connection-params-for-buffers (conn update-fn)
  "Apply UPDATE-FN to buffer-local connection params for buffers attached to CONN."
  (dolist (buf (buffer-list))
    (when (buffer-live-p buf)
      (with-current-buffer buf
        (when (eq clutch-connection conn)
          (setq-local clutch--connection-params
                      (funcall update-fn clutch--connection-params))
          (clutch--update-mode-line))))))

(defun clutch--list-clickhouse-databases (conn)
  "Return sorted database names visible to ClickHouse CONN."
  (sort
   (delete-dups
    (cl-loop for row in (clutch-db-result-rows (clutch-db-query conn "SHOW DATABASES"))
             for db = (car row)
             when (and (stringp db) (not (string-empty-p db)))
             collect db))
   #'string-collate-lessp))

;;;###autoload
(defun clutch-switch-database ()
  "Switch the current ClickHouse connection to another database by reconnecting."
  (interactive)
  (let* ((context (clutch--command-connection-context))
         (conn (or clutch-connection
                   (plist-get context :connection)
                   (user-error "No active connection")))
         (params (or (plist-get context :params)
                     (car (clutch--connection-context conn))
                     (user-error "No reconnect parameters for this connection")))
         (current (or (plist-get params :database) "default"))
         (databases (clutch--list-clickhouse-databases conn)))
    (unless (or (clutch--connection-clickhouse-p conn)
                (clutch--params-clickhouse-p params))
      (user-error "Runtime database switching is currently available only for ClickHouse"))
    (unless databases
      (user-error "No databases returned by SHOW DATABASES"))
    (let ((database (completing-read
                     (if current
                         (format "Switch to database (current %s): " current)
                       "Switch to database: ")
                     databases nil t nil nil current)))
      (unless (string-empty-p database)
        (if (string-equal database current)
            (message "Already on database %s" current)
          (when (clutch--connection-alive-p conn)
            (clutch--confirm-disconnect-transaction-loss
             conn
             "Uncommitted changes will be lost.  Switch database? "))
          (clutch--replace-connection
           conn
           (plist-put (copy-sequence params) :database database)
           (plist-get context :product))
          (message "Current database: %s" database))))))

;;;###autoload
(defun clutch-switch-schema ()
  "Switch the current schema or database on the active connection."
  (interactive)
  (let* ((context (clutch--command-connection-context))
         (conn (or clutch-connection
                   (plist-get context :connection)
                   (user-error "No active connection")))
         (params (or clutch--connection-params
                     (plist-get context :params))))
    (if (or (clutch--connection-clickhouse-p conn)
            (clutch--params-clickhouse-p params))
        (clutch-switch-database)
      (let* ((schemas (clutch-db-list-schemas conn))
             (current (clutch-db-current-schema conn))
             (old-key (clutch--connection-key conn)))
        (unless schemas
          (user-error "Runtime schema switching is not available for this connection"))
        (let ((schema (completing-read
                       (if current
                           (format "Switch to schema (current %s): " current)
                         "Switch to schema: ")
                       schemas nil t nil nil current)))
          (unless (string-empty-p schema)
            (if (and current
                     (string= (downcase schema) (downcase current)))
                (message "Already on schema %s" current)
              (condition-case err
                  (progn
                    (clutch-db-set-current-schema conn schema)
                    (clutch--clear-connection-problem-capture conn)
                    (clutch--update-connection-params-for-buffers
                     conn
                     (lambda (params)
                       (if (eq (plist-get params :backend) 'mysql)
                           (plist-put params :database schema)
                         (plist-put params :schema schema))))
                    (clutch--clear-connection-metadata-caches conn old-key)
                    (clutch--clear-connection-metadata-caches conn)
                    (clutch--refresh-current-schema t)
                    (message "Current schema: %s" schema))
                (clutch-db-error
                 (let* ((message (error-message-string err))
                        (summary (clutch--humanize-db-error message)))
                   (clutch--remember-buffer-query-error-details
                    (current-buffer) conn nil err)
                   (when clutch-debug-mode
                     (clutch--remember-debug-event
                      :connection conn
                      :op "schema-switch"
                      :phase "error"
                      :backend (clutch--backend-key-from-conn conn)
                      :summary summary
                      :context (list :schema schema
                                     :current-schema current)))
                   (user-error "%s"
                               (clutch--debug-workflow-message summary))))))))))))

;;;; Query editing major modes

(defvar clutch-mode-map
  (let ((map (make-sparse-keymap)))
    (set-keymap-parent map sql-mode-map)
    (clutch--install-query-keybindings map)
    (define-key map (kbd "C-c TAB") #'clutch-complete-at-point)
    (define-key map (kbd "C-c <tab>") #'clutch-complete-at-point)
    (define-key map (kbd "TAB") #'clutch-complete-qualified-or-indent)
    (define-key map (kbd "<tab>") #'clutch-complete-qualified-or-indent)
    map)
  "Keymap for `clutch-mode'.")

;;;###autoload
(define-derived-mode clutch-mode sql-mode "clutch"
  "Major mode for editing and executing SQL queries.

\\<clutch-mode-map>
Key bindings:
  \\[clutch-execute-dwim]	Execute region or statement/query at point
  \\[clutch-execute-region]	Execute region
  \\[clutch-execute-buffer]	Execute buffer
  \\[clutch-connect]	Connect to server
  \\[clutch-jump]	Object jump
  \\[clutch-describe-dwim]	Describe object
  \\[clutch-act-dwim]	Object actions
  \\[clutch-switch-schema]	Switch schema/database
  \\[clutch-complete-at-point]	Complete SQL identifier at point
  \\[clutch-complete-qualified-or-indent]	Complete qualified column or indent
  \\[clutch-preview-execution-sql]	Preview execution"
  (clutch--query-mode-common-setup)
  (clutch--install-completion-capfs)
  (add-hook 'eldoc-documentation-functions
            #'clutch--eldoc-function nil t)
  (add-hook 'xref-backend-functions #'clutch--xref-backend nil t))

;;;###autoload
(add-to-list 'auto-mode-alist '("\\.mysql\\'" . clutch-mode))

;;;###autoload
(autoload 'clutch-query-console "clutch" nil t)
;;;###autoload
(autoload 'clutch-query-sqlite-file "clutch" nil t)
;;;###autoload
(autoload 'clutch-switch-console "clutch" nil t)
;;;###autoload
(autoload 'clutch-execute "clutch" nil t)
;;;###autoload
(autoload 'clutch-edit-indirect "clutch" nil t)


;;;; REPL mode

(defvar clutch-repl-mode-map
  (let ((map (make-sparse-keymap)))
    (set-keymap-parent map comint-mode-map)
    (define-key map (kbd "RET") #'clutch-repl-send-input)
    (define-key map (kbd "<return>") #'clutch-repl-send-input)
    (define-key map (kbd "C-c C-e") #'clutch-connect)
    (define-key map (kbd "C-c C-m") #'clutch-commit)
    (define-key map (kbd "C-c C-u") #'clutch-rollback)
    (define-key map (kbd "C-c C-a") #'clutch-toggle-auto-commit)
    (define-key map (kbd "C-c C-j") #'clutch-jump)
    (define-key map (kbd "C-c C-d") #'clutch-describe-dwim)
    (define-key map (kbd "C-c C-o") #'clutch-act-dwim)
    (define-key map (kbd "C-c C-l") #'clutch-switch-schema)
    map)
  "Keymap for `clutch-repl-mode'.")

(defvar-local clutch-repl--pending-input ""
  "Accumulated partial SQL input waiting for a semicolon.")
;;;###autoload
(define-derived-mode clutch-repl-mode comint-mode "clutch-repl"
  "Major mode for database REPL.

\\<clutch-repl-mode-map>
  \\[clutch-connect]	Connect to server
  \\[clutch-jump]	Object jump
  \\[clutch-describe-dwim]	Describe object
  \\[clutch-act-dwim]	Object actions
  \\[clutch-switch-schema]	Switch schema/database"
  (setq comint-prompt-regexp "^db> \\|^    -> ")
  (setq comint-input-sender #'clutch-repl--input-sender)
  (clutch--install-completion-capfs)
  (add-hook 'xref-backend-functions #'clutch--xref-backend nil t)
  (add-hook 'kill-buffer-hook #'clutch--disconnect-on-kill nil t))

(defun clutch-repl--prompt (&optional continuation)
  "Return the REPL prompt string.
When CONTINUATION is non-nil, return the continuation prompt."
  (propertize (if continuation "    -> " "db> ")
              'face 'minibuffer-prompt))

(defun clutch-repl--input-start-position ()
  "Return the best input-start position for the current REPL line."
  (save-excursion
    (beginning-of-line)
    (if (looking-at comint-prompt-regexp)
        (match-end 0)
      (point))))

(defun clutch-repl--ensure-process ()
  "Ensure the current REPL buffer has a live dummy comint process."
  (let ((proc (get-buffer-process (current-buffer))))
    (if (and proc (process-live-p proc))
        proc
      (let ((mark-pos (and proc
                           (markerp (process-mark proc))
                           (marker-position (process-mark proc)))))
        (when proc
          (delete-process proc))
        (setq proc (start-process "clutch-repl" (current-buffer) "cat"))
        (set-process-query-on-exit-flag proc nil)
        (set-marker (process-mark proc)
                    (or mark-pos (clutch-repl--input-start-position))
                    (current-buffer))
        proc))))

;;;###autoload
(defun clutch-repl-send-input ()
  "Send REPL input, recreating the dummy comint process when needed."
  (interactive)
  (clutch-repl--ensure-process)
  (comint-send-input))

(defun clutch-repl--input-sender (_proc input)
  "Process INPUT from comint.
Accumulates input until a semicolon is found, then executes."
  (let ((combined (concat clutch-repl--pending-input
                          (unless (string-empty-p clutch-repl--pending-input) "\n")
                          input)))
    (if (string-match-p ";\\s-*$" combined)
        ;; Complete statement — execute
        (progn
          (setq clutch-repl--pending-input "")
          (clutch-repl--execute-and-print (string-trim combined)))
      ;; Incomplete — accumulate and show continuation prompt
      (setq clutch-repl--pending-input combined)
      (clutch-repl--output (clutch-repl--prompt t)))))

(defun clutch-repl--font-lock-output (text)
  "Return TEXT with display faces preserved in a font-locked REPL buffer."
  (let ((copy (copy-sequence text))
        (pos 0)
        next face)
    (while (< pos (length copy))
      (setq next (or (next-single-property-change pos 'face copy)
                     (length copy))
            face (get-text-property pos 'face copy))
      (when face
        (add-text-properties pos next `(font-lock-face ,face) copy))
      (setq pos next))
    copy))

(defun clutch-repl--output (text)
  "Insert TEXT into the REPL buffer at the process mark."
  (let ((inhibit-read-only t)
        (proc (clutch-repl--ensure-process)))
    (goto-char (process-mark proc))
    (insert (clutch-repl--font-lock-output text))
    (set-marker (process-mark proc) (point))))

(defun clutch-repl--format-dml-result (result elapsed)
  "Format a DML RESULT with ELAPSED time as a string for the REPL."
  (let ((msg (concat "\n"
                     (clutch--message-keyword "Affected rows")
                     ": "
                     (clutch--message-count
                      (or (clutch-db-result-affected-rows result) 0)))))
    (when-let* ((id (clutch-db-result-last-insert-id result))
                ((> id 0)))
      (setq msg (concat msg
                        ", "
                        (clutch--message-keyword "Last insert ID")
                        ": "
                        (clutch--message-count id))))
    (when-let* ((w (clutch-db-result-warnings result))
                ((> w 0)))
      (setq msg (concat msg
                        ", "
                        (clutch--message-keyword "Warnings")
                        ": "
                        (clutch--message-count w))))
    (concat msg
            " ("
            (clutch--message-literal (format "%.3fs" elapsed))
            ")\n\n"
            (clutch-repl--prompt))))

(defun clutch-repl--format-error (message)
  "Format MESSAGE as a REPL error."
  (concat "\n"
          (propertize "ERROR" 'face 'error)
          ": "
          (propertize message 'face 'clutch-error-summary-face)
          "\n\n"
          (clutch-repl--prompt)))

(defun clutch-repl--execute-and-print (sql)
  "Execute SQL from the REPL and display the result."
  (let ((repl-buffer (current-buffer))
        (repl-window (selected-window)))
    (cl-labels ((output (text)
                  (when (buffer-live-p repl-buffer)
                    (with-current-buffer repl-buffer
                      (clutch-repl--output text)))))
      (clutch--forget-problem-record repl-buffer clutch-connection)
      (condition-case err
          (progn
            (clutch--ensure-connection)
            (setq clutch--last-query sql)
            (let* ((start (float-time))
                   (result (clutch--run-db-query clutch-connection sql))
                   (elapsed (- (float-time) start))
                   (columns (clutch-db-result-columns result))
                   (rows (clutch-db-result-rows result)))
              (if columns
                  (progn
                    (unless (clutch-db-result-connection result)
                      (setf (clutch-db-result-connection result)
                            clutch-connection))
                    (unwind-protect
                        (clutch-result--display result sql elapsed)
                      (when (window-live-p repl-window)
                        (select-window repl-window)))
                    (output
                     (let ((row-count (length rows)))
                       (concat "\n"
                               (clutch--message-count row-count)
                               " "
                               (if (= row-count 1) "row" "rows")
                               " shown in "
                               (clutch--message-ident "result buffer")
                               " in "
                               (clutch--message-literal
                                (format "%.3fs" elapsed))
                               "\n\n"
                               (clutch-repl--prompt)))))
                (output (clutch-repl--format-dml-result result elapsed)))))
        (quit
         (condition-case nil
             (clutch--handle-query-quit clutch-connection)
           (clutch-query-interrupted
            (output (clutch-repl--format-error "Query interrupted")))))
        (error
         (clutch--remember-buffer-query-error-details
          repl-buffer clutch-connection sql err)
         (output
          (clutch-repl--format-error
           (clutch--humanize-db-error (error-message-string err)))))))))

;;;###autoload
(defun clutch-repl ()
  "Start a database REPL buffer."
  (interactive)
  (let* ((buf-name "*clutch REPL*")
         (buf (get-buffer-create buf-name)))
    (unless (comint-check-proc buf)
      (with-current-buffer buf
        (unless (derived-mode-p 'clutch-repl-mode)
          (clutch-repl-mode))
        (clutch-repl--ensure-process)
        (clutch-repl--output (clutch-repl--prompt))))
    (pop-to-buffer buf '((display-buffer-at-bottom)))))

;;;; Transient dispatch menus

(defun clutch--dispatch-transaction-controls-inapt-p ()
  "Return non-nil when current connection has no transaction controls."
  (not (and clutch-connection
            (clutch--manual-commit-supported-p clutch-connection))))

(transient-define-suffix clutch--dispatch-commit ()
  "Transient suffix for `clutch-commit'."
  :inapt-if #'clutch--dispatch-transaction-controls-inapt-p
  (interactive)
  (call-interactively #'clutch-commit))

(transient-define-suffix clutch--dispatch-rollback ()
  "Transient suffix for `clutch-rollback'."
  :inapt-if #'clutch--dispatch-transaction-controls-inapt-p
  (interactive)
  (call-interactively #'clutch-rollback))

(defun clutch--dispatch-auto-commit-description ()
  "Return the transient description for the current auto-commit state."
  (if (clutch--dispatch-transaction-controls-inapt-p)
      (concat "Auto-commit "
              (propertize "(unavailable)" 'face 'transient-inactive-value))
    (concat "Auto-commit "
            (clutch--transient-state-display
             (if (clutch-db-manual-commit-p clutch-connection) 'manual 'auto)
             '((manual . "manual") (auto . "auto"))))))

(transient-define-suffix clutch--dispatch-toggle-auto-commit ()
  "Transient suffix for `clutch-toggle-auto-commit' with a dynamic label."
  :description #'clutch--dispatch-auto-commit-description
  :inapt-if (lambda ()
               (or (clutch--dispatch-transaction-controls-inapt-p)
                   (and clutch-connection
                        (clutch-db-manual-commit-p clutch-connection)
                        (clutch--tx-dirty-p clutch-connection))))
  (interactive)
  (call-interactively #'clutch-toggle-auto-commit))

;;;###autoload (autoload 'clutch-dispatch "clutch" nil t)
(transient-define-prefix clutch-dispatch ()
  "Main dispatch menu for clutch."
  [ :pad-keys t
   ["Connection"
    ("c" "Connect"    clutch-connect)
    ("q" "Query console" clutch-query-console)
    ("f" "SQLite file" clutch-query-sqlite-file)
    ("S" "Prepare SSH" clutch-prepare-ssh-host)
    ("d" "Disconnect" clutch-disconnect)
    ("m" "Commit"            clutch--dispatch-commit)
    ("u" "Rollback"          clutch--dispatch-rollback)
    ("a" clutch--dispatch-toggle-auto-commit)
    ("R" "REPL"              clutch-repl)]
   ["Execute"
    ("x" "Query at point" clutch-execute-query-at-point)
    ("X" "Statement (;-only)" clutch-execute-statement-at-point)
    ("r" "Region"         clutch-execute-region)
    ("b" "Buffer"         clutch-execute-buffer)
    ("p" "Preview execution" clutch-preview-execution-sql)
    ("k" "Copy agent context" clutch-copy-context-for-agent)]
   ["Edit"
    ("'" "Indirect edit"  clutch-edit-indirect)]
   ["Objects"
    ("j" "Jump to object"     clutch-jump)
    ("D" "Describe object"    clutch-describe-dwim)
    ("o" "Object actions"     clutch-act-dwim)
    ("l" "Switch schema/db"   clutch-switch-schema)
    ("s" "Refresh schema"   clutch-refresh-schema)]])

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