;;; compiler-explorer.el --- Compiler explorer client (godbolt.org)  -*- lexical-binding: t; -*-

;; Copyright (C) 2020-2026  Michał Krzywkowski

;; Author: Michał Krzywkowski <k.michal@zoho.com>
;; Keywords: c, tools
;; Package-Version: 20260325.2318
;; Package-Revision: e26a4dac90ca
;; Homepage: https://github.com/mkcms/compiler-explorer.el
;; Package-Requires: ((emacs "28.1")
;;                    (plz "0.9")
;;                    (eldoc "1.15.0")
;;                    (map "3.3.1")
;;                    (seq "2.23"))

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

;;
;; * compiler-explorer.el
;;
;; Package that provides a client for https://godbolt.org service.
;;
;;
;; ** Usage
;;
;; M-x `compiler-explorer' is the main entry point.  It will ask you for a
;; language and display source&compilation buffers.  Type something in the
;; source buffer; the compilation buffer will automatically update with
;; compiled asm code.  Another buffer displays output of the compiled and
;; executed program.
;;
;;
;; *** Compilation
;;
;; M-x `compiler-explorer-set-compiler' changes the compiler for current
;; session.
;;
;; M-x `compiler-explorer-set-compiler-args' sets compilation options.
;;
;; M-x `compiler-explorer-add-library' asks for a library version and adds
;; it to current compilation.  M-x `compiler-explorer-remove-library'
;; removes them.
;;
;;
;; *** Execution
;;
;; M-x `compiler-explorer-set-execution-args' sets the arguments for the
;; executed program.
;;
;; M-x `compiler-explorer-set-input' reads a string from minibuffer that
;; will be used as input for the executed program.
;;
;;
;; *** Session management
;;
;; M-x `compiler-explorer-new-session' kills the current session and
;; creates a new one, asking for source language.
;;
;; M-x `compiler-explorer-previous-session' lets you restore previous
;; sessions.
;;
;; M-x `compiler-explorer-discard-session' kills the current or selected
;; sessions and forgets about them forever.
;;
;; M-x `compiler-explorer-exit' kills the current session.
;;
;;
;; *** ASM
;;
;; M-x `compiler-explorer-browse-opcode-documentation' opens a website
;; that contains the documentation for the opcode at point.
;;
;; M-x `compiler-explorer-jump' jumps to ASM block for the source line at
;; point and vice versa.
;;
;;
;; *** Tools
;;
;; M-x `compiler-explorer-add-tool' asks for the name of a tool, adds it
;; to current compilation and displays a new buffer showing the tool's
;; output.
;;
;; M-x `compiler-explorer-remove-tool' prompts for the name of an added
;; tool to remove.
;;
;; M-x `compiler-explorer-set-tool-args' sets the arguments for an added
;; tool.
;;
;; M-x `compiler-explorer-set-tool-input' reads a string from minibuffer
;; that will be used as input for an added tool.
;;
;;
;;
;; *** Other commands
;;
;; M-x `compiler-explorer-load-example' prompts for a name of a builtin
;; example and loads it.
;;
;; M-x `compiler-explorer-make-link' generates a link for current
;; compilation so it can be opened in a browser and shared.
;;
;; M-x `compiler-explorer-restore-from-link' restores a session from a
;; URL, generated by the website or by this package.
;;
;; M-x `compiler-explorer-layout' cycles between different layouts.
;;
;;
;; ** Customization
;;
;; Additional customization is possible via M-x `customize-group'
;; `compiler-explorer'.
;;
;;
;; *** Usage with language servers
;;
;; The following snippet sets up the built-in eglot package to start a
;; language server for each session, and to automatically create and
;; update a `compile_flags.txt' file (recognized by clangd) to have the
;; same compiler arguments that are set for the current session.  This
;; requires that the `compiler-explorer-make-temp-file' custom variable is
;; non-nil.
;;
;;
;;   (add-hook 'compiler-explorer-new-session-hook #'eglot-ensure)
;;
;;   (defun my/compiler-explorer-params-change-hook (what value)
;;     "Hook run when compilation parameters WHAT change to VALUE."
;;     (pcase what
;;       ('compiler-args
;;        (with-current-buffer compiler-explorer--buffer
;;          (when (derived-mode-p 'c-mode 'c++-mode)
;;            (with-temp-file "compile_flags.txt"
;;              (insert (mapconcat #'identity
;;                                 (split-string-and-unquote value) "\n")))
;;            (when (eglot-current-server)
;;              (eglot-reconnect (eglot-current-server))))))))
;;
;;   (add-hook 'compiler-explorer-params-change-hook
;;             #'my/compiler-explorer-params-change-hook)
;;
;;

;;; Code:

(require 'ansi-color)
(require 'browse-url)
(require 'color)
(require 'compile)
(require 'json)
(require 'plz)
(require 'pulse)
(require 'subr-x)
(require 'url-util)

;; `require'-ing these does not guarantee they are loaded as they are preloaded
;; in Emacs.
;;
;; This hack was stolen from the built-in eglot.el.
(eval-and-compile
  (load "eldoc" nil 'nomessage)
  (load "seq" nil 'nomessage)
  (load "map" nil 'nomessage))

(defgroup compiler-explorer nil "Client for compiler explorer service."
  :group 'tools)


;; API

(defvar ce-url "https://godbolt.org")

(defun ce--url (&rest chunks)
  "Make compiler explorer API endpoint URL from CHUNKS.
The last element can be an alist of (FIELD . VALUE) entries.
This alist will be encoded and appended to the URL as
URL parameters: ?FIELD1=VALUE1&FIELD2=VALUE2..."
  (let (params)
    (when-let* ((last (car (last chunks)))
                (is-alist (listp last)))
      (setq params last chunks (butlast chunks)))
    (concat
     ce-url "/api/" (string-join chunks "/")
     (when params
       (concat "?" (string-join (mapcar (pcase-lambda (`(,k . ,v))
                                          (concat (url-hexify-string k)
                                                  "="
                                                  (url-hexify-string v)))
                                        params)
                                "&"))))))

(defun ce--parse-json ()
  "Parse buffer as json plist."
  (let ((json-object-type 'plist))
    (json-read)))

(cl-defun ce--request-sync
    (what url &rest args
          &key
          (method 'get)
          (headers '(("Accept" . "application/json")))
          (as #'ce--parse-json)
          &allow-other-keys)
  "Perform sync `plz' request for URL, displaying WHAT with progress reporter."
  (let ((pr (make-progress-reporter what)))
    (unwind-protect
        (apply #'plz method url
               :headers headers
               :as as
               (map-delete args :method))
      (progress-reporter-done pr))))

(defvar ce--languages nil)
(defun ce--languages ()
  "Get all languages."
  (or ce--languages
      (setq ce--languages
            (ce--request-sync
             "Fetching list of languages"
             (ce--url
              "languages"
              `(("fields" . ,(string-join '("id" "name" "extensions" "example"
                                            "defaultCompiler")
                                          ","))))))))

(defvar ce--compilers nil)
(defun ce--compilers ()
  "Get all compilers."
  (or ce--compilers
      (setq ce--compilers
            (ce--request-sync
             "Fetching list of compilers"
             (ce--url
              "compilers"
              `(("fields" . ,(string-join '("id" "lang" "name" "groupName"
                                            "instructionSet"
                                            "supportsExecute"
                                            "supportsBinary"
                                            "supportsBinaryObject"
                                            "supportsLibraryCodeFilter"
                                            "supportsDemangle"
                                            "supportsIntel"
                                            "disabledFilters")
                                          ","))))))))

(defvar ce--libraries (make-hash-table :test #'equal))
(defun ce--libraries (id)
  "Get available libraries for language ID."
  (or (map-elt ce--libraries id)
      (setf (map-elt ce--libraries id)
            (ce--request-sync
             (format "Fetching %S libraries" id)
             (ce--url "libraries" id)))))

(defvar ce--asm-opcode-docs-cache
  (make-hash-table :test #'equal)
  "Hash table mapping opcodes to their docs.

Keys are strings of the form \\='ISET:OPCODE\\=', where ISET is the
compiler's :instructionSet.

Values are plists, which contain the documentation for the opcode.
Values can also be t, which means no documentation is available for the
key.")

(defun ce--asm-opcode-doc (instruction-set opcode callback &optional sync)
  "Get documentation for OPCODE in INSTRUCTION-SET and call CALLBACK.
Opcode should be a string.  INSTRUCTION-SET should be a valid
:instructionSet of some compiler.

CALLBACK is called with a plist argument.  The plist is of the
form: (:tooltip TOOLTIP :html HTML :url URL).  TOOLTIP is the short
documentation string.  HTML is full documentation in HTML.  URL is the
link to get more information for the opcode.

If SYNC is true, then wait until response arrives and call CALLBACK
immediately.

The return value will be:
- nil if documentation is not available
- t if it is (and callback was called)
- the symbol \\='async if a request to get that documentation was
sent, but the documentation is not available yet."
  (let* ((key (format "%s:%s" instruction-set opcode))
         (cache ce--asm-opcode-docs-cache)
         (resp (gethash key cache))
         (handler (lambda (response)
                    (funcall callback response)
                    (puthash key response cache))))
    (cond
     ((and resp (listp resp)) (funcall callback resp) t)
     ((eq resp t) nil)
     (t
      (setq resp
            (condition-case err
                (plz 'get
                  (ce--url "asm" instruction-set opcode)
                  :headers '(("Accept" . "application/json"))
                  :then (if sync 'sync handler)
                  :else (lambda (_err) (puthash key t cache))
                  :as #'ce--parse-json)
              (plz-error
               (puthash key t cache)
               (or sync (signal (car err) (cdr err)))
               nil)))
      (if sync
          (and resp (funcall handler resp) t)
        'async)))))

(defvar ce--examples nil)
(defun ce--examples (&optional lang)
  "Get an alist of the examples.
Keys are example names, values are example objects as returned by the API.
If LANG is non-nil, return only examples for language with that id."
  (let ((examples
         (or ce--examples
             (setq ce--examples
                   (ce--request-sync
                    (format "Fetching %S examples" (or lang "all"))
                    (concat ce-url "/source/builtin/list"))))))
    (remq 'none
          (mapcar
           (lambda (example)
             (or
              (and lang (not (string= lang (plist-get example :lang))) 'none)
              (cons (plist-get example :name) example)))
           examples))))

(defvar ce--cached-example-data (make-hash-table :test #'equal)
  "Keys are strings of the form LANG:EXAMPLE-FILE.
Values are the example objects from API.")

(defun ce--example (lang file)
  "Get a single example FILE in LANG."
  (let ((key (format "%s:%s" lang file)))
    (or (map-elt ce--cached-example-data key)
        (setf
         (map-elt ce--cached-example-data key)
         (ce--request-sync
          (format "Fetching %S example %s" lang file)
          (concat
           ce-url "/source/builtin/load/" lang "/" file))))))

(defvar ce--tools nil)
(defun ce--tools (lang)
  "Get a list of tools for given LANG."
  (if (assoc lang ce--tools)
      (map-elt ce--tools lang)
    (setf
     (map-elt ce--tools lang)
     (seq-map (lambda (elt) (cons (plist-get elt :id) elt))
              (ce--request-sync
               (format "Fetching %S tools" (or lang "all"))
               (ce--url "tools" lang))))))


;; Compilation

(defconst ce--buffer "*compiler-explorer*"
  "Buffer with source code.")

(defconst ce--compiler-buffer "*compiler-explorer compilation*"
  "Buffer with ASM code.")

(defconst ce--output-buffer "*compiler-explorer output*"
  "Combined compiler stdout&stderr.")

(defconst ce--exe-output-buffer
  "*compiler-explorer execution output*"
  "Buffer with execution output.")

(defconst ce--tool-buffer-format "*compiler-explorer tool %s*"
  "Template for tool buffer names.")

(defvar ce--language-data nil
  "Language data for current session.")

(defvar ce--compiler-data nil
  "Compiler data for current session.")

(defvar ce--selected-libraries nil
  "Alist of libraries for current session.
Keys are library ids, values are lists (VERSION ENTRY), where
VERSION is the id string of the version and ENTRY is the library
entry from function `compiler-explorer--libraries'.")

(defvar ce--selected-tools nil
  "Alist of tools for current session.
Keys are tool ids, and values are lists (BUFFER ARGS STDIN), where
BUFFER is the tool's buffer, ARGS is a string with the arguments, and
STDIN is a string.")

(defvar ce--compiler-arguments ""
  "Arguments for the compiler.")

(defvar ce--execution-arguments ""
  "Arguments for the program executed.")

(defvar ce--execution-input ""
  "Stdin for the program executed.")

(defvar ce--recompile-timer nil
  "Timer for recompilation.")

(defvar ce--last-compilation-request nil
  "Last request (response) for current compilation.")

(defvar ce--last-exe-request nil
  "Last request (response) for current execution.")

(defvar ce-response-limit-bytes (* 1000 1000)
  "Limit in bytes for responses to compilation requests.
If a compilation response is larger than this, it is not parsed
with `json-parse', and a message is displayed.")

(defun ce--parse-json-compilation ()
  "Parse current buffer as json, but only if it's size is reasonable."
  (cond
   ((< (buffer-size) ce-response-limit-bytes)
    (ce--parse-json))
   (t
    (let ((msg `[(:text
                  ,(format
                    "ERROR: Response too large to parse. (%s kB, limit %s kB)"
                    (/ (buffer-size) 1000)
                    (/ ce-response-limit-bytes 1000)))
                 (:text "Increase the limit by setting ")
                 (:text "`compiler-explorer-response-limit-bytes'")]))
      `(:asm ,msg
             :stderr ,msg
             :code -1
             :tools ,(mapcar
                      (lambda (id) `(:id ,id :stderr ,msg))
                      (mapcar #'car ce--selected-tools)))))))

(defcustom ce-output-filters '(:binary nil
                                       :binaryObject nil
                                       :commentOnly t
                                       :demangle t
                                       :directives t
                                       :intel t
                                       :labels t
                                       :libraryCode t
                                       :trim nil
                                       :debugCalls nil)
  "Compiler output filters."
  :type '(plist :key-type
                (choice
                 (const :tag "Compile to binary" :binary)
                 (const :tag "Compile to binary object" :binaryObject)
                 (const :tag "Comments" :commentOnly)
                 (const :tag "Demangle C++ symbols" :demangle)
                 (const :tag "Directives" :directives)
                 (const :tag "Intel ASM syntax" :intel)
                 (const :tag "Unused labels" :labels)
                 (const :tag "Library code" :libraryCode)
                 (const :tag "Trim whitespace" :trim)
                 (const :tag "Debug intrinsics" :debugCalls))
                :value-type boolean))

(defun ce--filter-enabled-p (filter)
  "Return non-nil if FILTER can be used in the current session."
  (pcase-let (((map :supportsBinary :supportsBinaryObject
                    :supportsLibraryCodeFilter :supportsDemangle
                    :supportsIntel
                    :disabledFilters)
               ce--compiler-data))
    (and (cl-case filter
           (:binary (eq t supportsBinary))
           (:binaryObject (eq t supportsBinaryObject))
           (:libraryCode (eq t supportsLibraryCodeFilter))
           (:demangle (eq t supportsDemangle))
           (:intel (eq t supportsIntel))
           (t t))
         (not (seq-contains-p disabledFilters
                              (substring (symbol-name filter) 1))))))

(defun ce--output-filters ()
  "Get output filters options in a form suitable for making a request."
  (cl-loop for (k v) on ce-output-filters by #'cddr
           if (ce--filter-enabled-p k)
           nconc (list k (or v :json-false))))

(defvar ce--inhibit-request nil
  "If non-nil, inhibit making the async compilation/execution request.
This can be temporarily let-bound to defer making async requests
when multiple functions try to do it in a block of code.")

(defun ce--schedule-compilation (&rest _args)
  "Schedule recompilation after buffer is modified."
  (when ce--recompile-timer
    (cancel-timer ce--recompile-timer))
  (setq ce--recompile-timer (run-with-timer 0.5 nil #'ce--request-async))

  ;; Prevent 'kill anyway?' when killing the buffer.
  (restore-buffer-modified-p nil)

  ;; Set the header line status to "Wait..."
  (force-mode-line-update t))

(defun ce--request-async-1 ()
  "Subr of `compiler-explorer--request-async'."
  (pcase-dolist
      (`(,executorRequest ,symbol ,handler)
       `((:json-false
          ce--last-compilation-request
          ce--handle-compilation-response)
         ,@(when (eq t (plist-get ce--compiler-data
                                  :supportsExecute))
             '((t
                ce--last-exe-request
                ce--handle-execution-response)))))
    (when-let* ((last (symbol-value symbol)))
      ;; Abort last request
      (when (process-live-p last)
        (delete-process last)))
    (let (proc)
      (setq
       proc
       (set symbol
            (plz 'post
              (ce--url
               "compiler" (plist-get ce--compiler-data :id)
               "compile")
              :headers '(("Accept" . "application/json")
                         ("Content-Type" . "application/json"))
              :body (let ((json-object-type 'plist))
                      (json-encode
                       `(
                         :source
                         ,(with-current-buffer ce--buffer
                            (buffer-string))
                         :options
                         (
                          :userArguments ,ce--compiler-arguments
                          :executeParameters
                          (
                           :args ,ce--execution-arguments
                           :stdin ,ce--execution-input)
                          :compilerOptions
                          (
                           :skipAsm :json-false
                           :executorRequest ,executorRequest)
                          :filters ,(ce--output-filters)
                          :tools
                          [,@(mapcar
                              (pcase-lambda (`(,id ,_ ,args ,stdin))
                                `(:id ,id
                                      :args ,(seq-into
                                              (split-string-and-unquote args)
                                              'vector)
                                      :stdin ,stdin))
                              ce--selected-tools)]
                          :libraries
                          [,@(mapcar
                              (pcase-lambda (`(,id ,version ,_))
                                `(:id ,id :version ,version))
                              ce--selected-libraries)])
                         :allowStoreCodeDebug :json-false)))
              :as #'ce--parse-json-compilation
              :then (lambda (resp)
                      (unless (plz-error-p resp)
                        (funcall handler resp)
                        (process-put proc 'ce-response-data
                                     resp))))))))
  (unless (eq t (plist-get ce--compiler-data :supportsExecute))
    (setq ce--last-exe-request nil)
    (ce--handle-compiler-with-no-execution))
  (ce--build-overlays nil)
  (force-mode-line-update))

(defun ce--request-async ()
  "Queue compilation and execution and return immediately.
This calls `compiler-explorer--handle-compilation-response' and
`compiler-explorer--handle-execution-response' once the responses arrive."
  (unless ce--inhibit-request
    (ce--request-async-1)))

(defvar ce--project-dir)

;; TODO: Instead, we can allow the user to provide the user the option to
;; provide MAX-SECS and MAX-COSTS arguments to `replace-region-contents'.
(defcustom ce-replace-insert-nondestructively 25000
  "Replace buffer contents nondestructively if it's size is less than this.

When handling compilation response, the disassembled code is
inserted into a temporary buffer; if the size of this temporary
buffer is less than this, and if the size of the current
disassembly buffer is less than this value, the contents of the
current disassembly buffer are replaced with the contents of the
temporary buffer with `replace-region-contents'.  This is slow
for large buffers, but has the advantage of properly preserving
point.

If the size of any of the two buffers is larger than this, the
contents are replaced destructively and point is not preserved."
  :type 'integer)

(defun ce--replace-buffer-contents (target source)
  "Replace contents of buffer TARGET with SOURCE."
  (let ((limit ce-replace-insert-nondestructively))
    (with-current-buffer target
      (let ((inhibit-read-only t))
        ;; We need to remove all overlays applied by ansi-color first,
        ;; otherwise sometimes `replace-region-contents' will improperly merge
        ;; the existing ANSI-coded regions with the new text.
        (delete-all-overlays)
        (set-text-properties (point-min) (point-max) nil)

        (if (and (< (buffer-size target) limit)
                 (< (buffer-size source) limit))
            (replace-region-contents (point-min) (point-max)
                                     (lambda () source))
          (erase-buffer)
          (insert-buffer-substring source))))))

(defvar ce-post-compilation-hook nil
  "Hook called after recompilation is performed.
The ASM buffer is current when this hook runs.")

(defvar ce-post-tool-update-hook nil
  "Hook called after a tool's buffer is updated.
The hook is called with a single argument that contains the tool ID.
The tool buffer is current when this hook runs.")

(defvar ce-document-opcodes)
(defvar ce-source-to-asm-mappings)
(defun ce--handle-compilation-response (response)
  "Handle compilation response contained in RESPONSE."
  (pcase-let (((map :asm :stdout :stderr :code :tools) response)
              (compiler (get-buffer ce--compiler-buffer))
              (output (get-buffer ce--output-buffer))
              (source-to-asm-mappings nil))
    (with-current-buffer compiler
      (with-temp-buffer
        (seq-do
         (pcase-lambda ((map :text (:source (and source (map :line :file)))))
           (let (mapping)
             (when (and ce-source-to-asm-mappings line
                        (plist-member source :file) (null file) (> line 0))
               (if (setq mapping (assq line source-to-asm-mappings))
                   (push (point) (cdr mapping))
                 (push (cons line (list (point))) source-to-asm-mappings))))
           (insert text "\n"))
         asm)
        (ce--replace-buffer-contents compiler (current-buffer)))

      (when ce-source-to-asm-mappings
        (ce--build-overlays source-to-asm-mappings)))

    ;; Update output buffer
    (with-current-buffer output
      (with-temp-buffer
        (insert (mapconcat (lambda (line) (plist-get line :text))
                           stdout "\n")
                "\n")
        (insert (mapconcat (lambda (line) (plist-get line :text))
                           stderr "\n")
                "\n")
        (insert (format "Compiler exited with code %s" code))
        (ce--replace-buffer-contents output (current-buffer)))
      (let ((inhibit-read-only t))
        (ansi-color-apply-on-region (point-min) (point-max)))

      (with-demoted-errors "compilation-parse-errors: %s"
        (let ((inhibit-read-only t))
          (compilation-parse-errors (point-min) (point-max)))))

    ;; Update tools
    (let ((all-tools (copy-tree ce--selected-tools)))
      (pcase-dolist ((map :id :stderr :stdout) (seq-into tools 'list))
        (when-let* ((toolbuf
                     (cadr (assoc id ce--selected-tools))))
          (with-temp-buffer
            (seq-do (pcase-lambda ((map :text)) (insert text "\n"))
                    (seq-concatenate 'list stdout stderr))
            (ce--replace-buffer-contents toolbuf
                                         (current-buffer))
            (setq all-tools (assoc-delete-all id all-tools))

            (with-current-buffer toolbuf
              (let ((inhibit-read-only t))
                (ansi-color-apply-on-region (point-min) (point-max)))
              (when (derived-mode-p 'compilation-mode)
                (with-demoted-errors "compilation-parse-errors: %s"
                  (let ((inhibit-read-only t))
                    (compilation-parse-errors (point-min) (point-max)))))
              (run-hook-with-args 'ce-post-tool-update-hook id)))))
      (pcase-dolist (`(,id ,buf ,_) all-tools)
        (when (buffer-live-p buf)
          (with-current-buffer buf
            (let ((inhibit-read-only t))
              (erase-buffer)
              (insert "Error: The current language/")
              (insert "compiler does not support this tool.\n"))
            (run-hook-with-args 'ce-post-tool-update-hook id)))))

    (with-current-buffer compiler
      (run-hooks 'ce-post-compilation-hook)))
  (force-mode-line-update t))

(defvar ce-post-execution-hook nil
  "Hook called after execution is performed.
The execution buffer is current when this hook runs.")

(defun ce--handle-compiler-with-no-execution ()
  "Update the execution output buffer with info about unsupported compiler.
This will write the list of supported compilers in the execution
output buffer."
  (with-current-buffer ce--exe-output-buffer
    (let ((inhibit-read-only t)
          (keymap (make-keymap))
          (compiler (plist-get ce--compiler-data :name))
          (lang-id (plist-get ce--language-data :id)))
      (define-key keymap [mouse-1] 'ce-set-compiler)
      (erase-buffer)
      (save-excursion
        (insert (format "Error: The %s compiler does not support execution."
                        (propertize compiler 'face 'underline)))
        (insert "\n\n")
        (insert "The current language supports execution with these "
                "compilers (click to set):\n")

        (seq-do
         (pcase-lambda ((map :lang :id :supportsExecute :name))
           (when (and (eq t supportsExecute) (string= lang lang-id))
             (insert " "
                     (propertize name
                                 'ce-compiler-id id
                                 'face 'link
                                 'mouse-face 'highlight
                                 'keymap keymap
                                 'help-echo "Click to set")
                     "\n")))
         (ce--compilers))))
    (run-hooks 'ce-post-execution-hook)))

(defun ce--handle-execution-response (response)
  "Handle execution response contained in RESPONSE."
  (pcase-let (((map :stdout :stderr :code) response))
    (with-current-buffer ce--exe-output-buffer
      (let ((inhibit-read-only t)
            (buf (current-buffer)))
        (with-temp-buffer
          (insert "Program stdout:\n")
          (insert (mapconcat (lambda (line) (plist-get line :text))
                             stdout "\n")
                  "\n")
          (insert "Program stderr:\n")
          (insert (mapconcat (lambda (line) (plist-get line :text))
                             stderr "\n")
                  "\n")
          (insert (format "Program exited with code %s" code))
          (ce--replace-buffer-contents buf (current-buffer)))
        (ansi-color-apply-on-region (point-min) (point-max)))
      (run-hooks 'ce-post-execution-hook))))


;; UI

(defun ce--header-line-format-common ()
  "Get the mode line template used in compiler explorer mode."
  (let* ((is-exe (eq (current-buffer)
                     (get-buffer ce--exe-output-buffer)))
         (resp (if is-exe ce--last-exe-request ce--last-compilation-request)))
    (propertize
     (concat "CE: "
             (cond
              ((and (null resp) is-exe
                    (eq :json-false
                        (plist-get ce--compiler-data :supportsExecute)))
               (propertize "ERROR" 'face 'error))
              ((null resp) "")
              ((or (process-live-p resp)
                   (member ce--recompile-timer timer-list))
               "Wait...")
              ((/= 0 (process-exit-status resp))
               (propertize "ERROR" 'face 'error
                           'help-echo (format
                                       "Status: %s\nCode: %s"
                                       (process-status resp)
                                       (process-exit-status resp))))
              (t
               (pcase-let (((map :stdout :stderr)
                            (process-get resp
                                         'ce-response-data)))
                 (propertize
                  (format "%s (%s/%s)"
                          (propertize "Done" 'face 'success)
                          (length stdout)
                          (propertize (format "%s" (length stderr))
                                      'face (if (> (length stderr) 0) 'error)))
                  'help-echo (with-current-buffer ce--output-buffer
                               ;; Get at most 30 output lines
                               (save-excursion
                                 (goto-char (point-min))
                                 (forward-line 30)
                                 (concat
                                  (buffer-substring (point-min)
                                                    (line-beginning-position))
                                  (unless (= (line-beginning-position)
                                             (point-max))
                                    (concat "... message truncated. "
                                            "See output buffer to "
                                            "show all.\n"))
                                  "\nmouse-1: "
                                  " Show output buffer."))))))))
     'mouse-face 'mode-line-highlight
     'keymap (let ((map (make-keymap)))
               (define-key map [header-line mouse-1] #'ce-show-output)
               map))))

(defvar ce--last-layout)
(defvar ce-layouts)

(defun ce--header-line-format-source ()
  "Get mode line construct for displaying header line in source buffer."
  `(
    (:eval (ce--header-line-format-common))
    " | "
    ,(propertize
      (plist-get ce--language-data :name)
      'mouse-face 'header-line-highlight
      'keymap (let ((map (make-keymap)))
                (define-key map [header-line mouse-1] #'ce-new-session)
                (define-key map [header-line mouse-2] #'ce-previous-session)
                map)
      'help-echo (concat "mouse-1: New session\n"
                         "mouse-2: Previous session"))
    " | "
    ,(propertize
      (format "Layout: %d" ce--last-layout)
      'mouse-face 'header-line-highlight
      'keymap (let ((map (make-keymap)))
                (define-key map [header-line mouse-1]
                            (lambda ()
                              (interactive)
                              (ce-layout (1+ ce--last-layout))))
                (define-key map [header-line mouse-2]
                            (lambda ()
                              (interactive)
                              (ce-layout (if (zerop ce--last-layout)
                                             (1- (length ce-layouts))
                                           (1- ce--last-layout)))))
                map)
      'help-echo (concat "mouse-1: Next layout\n"
                         "mouse-2: Previous layout"))))

(defun ce--header-line-format-compiler ()
  "Get mode line construct for displaying header line in compilation buffers."
  `(
    (:eval (ce--header-line-format-common))
    " | "
    ,(propertize
      (plist-get ce--compiler-data :name)
      'mouse-face 'header-line-highlight
      'keymap (let ((map (make-keymap)))
                (define-key map [header-line mouse-1] #'ce-set-compiler)
                map)
      'help-echo "mouse-1: Select compiler")
    " | "
    ,(propertize
      (format "Libs: %s"  (length ce--selected-libraries))
      'mouse-face 'header-line-highlight
      'keymap (let ((map (make-keymap)))
                (define-key map [header-line mouse-1] #'ce-add-library)
                (define-key map [header-line mouse-2] #'ce-remove-library)
                map)
      'help-echo (concat
                  "Libraries:\n"
                  (mapconcat
                   (pcase-lambda (`(,_ ,vid ,(map :name :versions)))
                     (format "%s %s" name
                             (cl-loop for version across versions
                                      for id = (plist-get version :id)
                                      when (string= id vid)
                                      return (plist-get version :version))))
                   ce--selected-libraries
                   "\n")
                  "\n\n"
                  "mouse-1: Add library\n"
                  "mouse-2: Remove library\n"))
    " | "
    ,(propertize (format "Args: '%s'" ce--compiler-arguments)
                 'mouse-face 'header-line-highlight
                 'keymap (let ((map (make-keymap)))
                           (define-key map [header-line mouse-1]
                                       #'ce-set-compiler-args)
                           map)
                 'help-echo "mouse-1: Set arguments")))

(defun ce--header-line-format-executor ()
  "Get mode line construct for displaying header line in execution buffers."
  `(
    (:eval (ce--header-line-format-common))
    " | "
    ,(propertize
      (format "Input: %s chars" (length ce--execution-input))
      'mouse-face 'header-line-highlight
      'keymap (let ((map (make-keymap)))
                (define-key map [header-line mouse-1] #'ce-set-input)
                map)
      'help-echo "mouse-1: Set program input")
    " | "
    ,(propertize
      (format "Args: '%s'" ce--execution-arguments)
      'mouse-face 'header-line-highlight
      'keymap (let ((map (make-keymap)))
                (define-key map [header-line mouse-1] #'ce-set-execution-args)
                map)
      'help-echo "mouse-1: Set program arguments")))

(defvar ce--tool-context)

(defun ce--header-line-format-tool ()
  "Get mode line construct for displaying header line in tool buffers."
  `(
    (:eval (ce--header-line-format-common))
    " | "
    ,(propertize
      (format "Tool: %s" (ce--tool-name (ce--tool-id)))
      'mouse-face 'header-line-highlight
      'keymap (let ((map (make-keymap))
                    (id (ce--tool-id)))
                (define-key map [header-line mouse-1]
                            (lambda ()
                              (interactive)
                              (ce-remove-tool id)))
                map)
      'help-echo "mouse-1: Remove this tool")
    " | "
    ,(propertize
      (format "Args: '%s'"
              (caddr (assoc (ce--tool-id)
                            ce--selected-tools)))
      'mouse-face 'header-line-highlight
      'keymap (let ((map (make-keymap))
                    (id (ce--tool-id)))
                (define-key
                 map [header-line mouse-1]
                 (lambda ()
                   (interactive)
                   (let ((ce--tool-context id))
                     (call-interactively #'ce-set-tool-args))))
                map)
      'help-echo "mouse-1: Set program arguments")
    " | "
    ,(propertize
      (format "Input: %s chars"
              (length (cadddr (assoc (ce--tool-id) ce--selected-tools))))
      'mouse-face 'header-line-highlight
      'keymap (let ((map (make-keymap))
                    (id (ce--tool-id)))
                (define-key
                 map [header-line mouse-1]
                 (lambda ()
                   (interactive)
                   (let ((ce--tool-context id))
                     (call-interactively #'ce-set-tool-input))))
                map)
      'help-echo "mouse-1: Set tool input")))

(defvar ce-mode-map)

(defun ce--define-menu ()
  "Define a menu in the menu bar for `compiler-explorer' commands."
  (easy-menu-define ce-menu
    ce-mode-map "Compiler Explorer"
    `("Compiler Explorer"
      ["Previous session" ce-previous-session]
      ("Restore session"
       :enable (not (seq-empty-p (ce--session-alist)))
       ,@(mapcar (pcase-lambda (`(,string ,_ ,index))
                   (vector string
                           (lambda ()
                             (interactive)
                             (ce-previous-session index))))
                 (ce--session-alist)))
      ("New session"
       ,@(mapcar
          (pcase-lambda ((map :name))
            (vector name (lambda ()
                           (interactive)
                           (ce-new-session name t))))
          (seq-sort-by (lambda (lang) (plist-get lang :name))
                       #'string< (ce--languages))))
      ("Load example"
       ,@(mapcar
          (lambda (name)
            (vector name (lambda () (interactive) (ce-load-example name))))
          (mapcar #'car (ce--examples (plist-get ce--language-data :id)))))
      "--"
      ("Compiler"
       ,@(let ((compilers
                (cl-remove-if
                 (pcase-lambda ((map :lang))
                   (not (string= lang (plist-get ce--language-data :id))))
                 (ce--compilers)))
               (by-group (make-hash-table :test #'equal)))
           (cl-loop for compiler across compilers
                    for name = (plist-get compiler :name)
                    for group-name = (plist-get compiler :groupName)
                    for group = (map-elt by-group group-name)
                    if group do (nconc group (list name))
                    else do (setf (map-elt by-group group-name) (list name)))
           (seq-sort-by
            #'car #'string<
            (map-apply
             (lambda (group compilers-in-group)
               (cl-list*
                (if (string-empty-p group) "Other compilers" group)
                (mapcar (lambda (name)
                          (vector name
                                  (lambda ()
                                    (interactive)
                                    (ce-set-compiler name))))
                        compilers-in-group)))
             by-group))))
      ["Set compilation arguments" ce-set-compiler-args]
      ("Add library"
       :enable (not
                (seq-empty-p
                 (ce--libraries (plist-get ce--language-data :id))))
       ,@(mapcar
          (pcase-lambda ((map :name :id :versions))
            (cl-list*
             name
             :enable `(null (assoc ,id ce--selected-libraries))
             (mapcar
              (pcase-lambda ((map :version (:id version-id)))
                (vector
                 (format "%s %s" name version)
                 (lambda () (interactive) (ce-add-library id version-id))))
              versions)))
          (ce--libraries
           (plist-get ce--language-data :id))))
      ("Remove library"
       :enable (not (null ce--selected-libraries))
       ,@(mapcar
          (pcase-lambda (`(,library-id ,version-id ,(map :name :versions)))
            (vector (format "%s %s"
                            name
                            (cl-loop for version across versions
                                     for id = (plist-get version :id)
                                     when (string= id version-id)
                                     return (plist-get version :version)))
                    (lambda () (interactive) (ce-remove-library library-id))))
          ce--selected-libraries))
      "--"
      ("Add tool"
       :enable
       (not (seq-empty-p (ce--tools (plist-get ce--language-data :id))))
       ,@(mapcar
          (pcase-lambda (`(,id . ,_))
            (vector (ce--tool-name id)
                    (lambda ()
                      (interactive)
                      (ce-add-tool id))
                    :enable
                    `(null (assoc ,id ce--selected-tools))))
          (ce--tools (plist-get ce--language-data :id))))
      ("Remove tool"
       :enable (not (null ce--selected-tools))
       ,@(mapcar
          (lambda (id)
            (vector (ce--tool-name id)
                    (lambda () (interactive) (ce-remove-tool id))))
          (mapcar #'car ce--selected-tools)))
      ("Set tool arguments"
       :enable (not (null ce--selected-tools))
       ,@(mapcar
          (lambda (id)
            (vector
             (ce--tool-name id)
             (lambda ()
               (interactive)
               (let ((ce--tool-context id))
                 (call-interactively #'ce-set-tool-args)))))
          (mapcar #'car ce--selected-tools)))
      ("Set tool input"
       :enable (not (null ce--selected-tools))
       ,@(mapcar
          (lambda (id) (vector (ce--tool-name id)
                               (lambda ()
                                 (interactive)
                                 (let ((ce--tool-context id))
                                   (call-interactively #'ce-set-tool-input)))))
          (mapcar #'car ce--selected-tools)))
      "--"
      ["Set execution arguments" ce-set-execution-args]
      ["Set execution input" ce-set-input]
      "--"
      ("Output filters"
       ,@(cl-loop
          for (key v) on ce-output-filters by #'cddr
          for is-enabled = (ce--filter-enabled-p key)
          with name-alist =
          (cl-loop for elt in
                   (cdaddr (get 'ce-output-filters 'custom-type))
                   collect (cons (car (last elt)) (car (last elt 2))))
          collect (vector (or (cdr (assoc key name-alist)))
                          `(lambda ()
                             (interactive)
                             (setq ce-output-filters
                                   (plist-put ce-output-filters ,key (not ,v)))
                             (ce--request-async)
                             (ce--define-menu))
                          :style 'toggle
                          :selected v
                          :enable is-enabled)))
      ["Source to ASM mappings"
       (lambda ()
         (interactive)
         (setq ce-source-to-asm-mappings (not ce-source-to-asm-mappings))
         (ce--request-async))
       :style toggle :selected ce-source-to-asm-mappings]
      ["Next layout" ce-layout]
      ["Copy link to this session" ce-make-link]
      "--"
      ["Exit" ce-exit])))


;; Other internal functions

(defvar ce--session-ring)
(defvar ce-mode)
(defvar ce--cleaning-up nil)

(defun ce--tool-id ()
  "Get the ID of the tool in the current buffer, or return nil."
  (car (cl-find (current-buffer) ce--selected-tools :key #'cadr)))

(defun ce--tool-name (id)
  "Return the name of a tool with given ID."
  (let* ((lang (or (and (ce-active-p)
                        (plist-get ce--language-data :id))
                   (error "Not in a `compiler-explorer' session")))
         (tool-data (map-elt (ce--tools lang) id)))
    (or (plist-get tool-data :name) id)))

(defun ce--window-layout (&optional window)
  "Get the window layout of WINDOW, suitable for `compiler-explorer-layout'.
WINDOW if nil defaults to the frame's root window."
  (or window (setq window (frame-root-window)))
  (cond
   ((window-live-p window)
    (pcase (window-buffer window)
      ((pred (eq (get-buffer ce--buffer)))
       'source)
      ((pred (eq (get-buffer ce--compiler-buffer)))
       'asm)
      ((pred (eq (get-buffer ce--output-buffer)))
       'output)
      ((pred (eq (get-buffer ce--exe-output-buffer)))
       'exe)
      ((pred (lambda (buf) (memq buf (mapcar #'cadr ce--selected-tools))))
       'tool)))
   ((window-left-child window)
    (cl-loop
     with child = (window-left-child window)
     with ret = nil
     while child
     for layout = (ce--window-layout child)
     do (setq ret (if ret (cons ret layout) layout)
              child (window-next-sibling child))
     finally return ret))
   ((window-top-child window)
    (cl-loop
     with child = (window-top-child window)
     with ret = nil
     while child
     for layout = (ce--window-layout child)
     do (setq ret (if ret (vector ret layout) layout)
              child (window-next-sibling child))
     finally return ret))))

(defun ce--session-savable-p ()
  "Return non-nil if the current session should be saved.
A session that has no source code or is the same as an
example/default is not saved."
  (and (ce-active-p)
       (let ((example
              (or (plist-get ce--language-data :example) ""))
             (string (with-current-buffer ce--buffer
                       (string-trim (buffer-string)))))
         (not (or (string-empty-p string)
                  (string= string (string-trim example)))))))

(defvar ce-pre-cleanup-hook nil
  "Hook called before session teardown.")

(defun ce--cleanup-1 (&optional skip-save-session)
  "Kill current session.
If SKIP-SAVE-SESSION is non-nil, don't attempt to save the last session."
  (when (ce-active-p)
    (with-demoted-errors "compiler-explorer--cleanup: %s"
      (run-hooks 'ce-pre-cleanup-hook )))

  (when (and (not skip-save-session) (ce--session-savable-p))
    (push (ce--current-session) ce--session-ring))

  ;; Abort last request and cancel the timer for recompilation.
  (with-demoted-errors "compiler-explorer--cleanup: %s"
    (when-let* ((req ce--last-compilation-request))
      (when (process-live-p req)
        (delete-process req)))
    (when-let* ((req ce--last-exe-request))
      (when (process-live-p req)
        (delete-process req)))
    (when ce--recompile-timer
      (cancel-timer ce--recompile-timer)))

  ;; Kill all of our buffers.
  (mapc (lambda (buffer)
          (when (buffer-live-p buffer)
            (with-current-buffer buffer
              (let ((kill-buffer-query-functions nil))
                ;; Give `kill-buffer-hook' a chance to run, but if they fail to
                ;; kill the buffer, kill it forcibly without running them.
                (unless (save-current-buffer
                          (ignore-errors (kill-buffer buffer)))
                  (let ((kill-buffer-hook nil))
                    (kill-buffer (current-buffer))))))))
        (cl-list* (get-buffer ce--buffer)
                  (get-buffer ce--compiler-buffer)
                  (get-buffer ce--output-buffer)
                  (get-buffer ce--exe-output-buffer)
                  (mapcar #'cadr ce--selected-tools)))

  (setq ce--last-compilation-request nil)
  (setq ce--recompile-timer nil)
  (setq ce--last-exe-request nil)
  (setq ce--compiler-data nil)
  (setq ce--selected-libraries nil)
  (setq ce--selected-tools nil)
  (setq ce--language-data nil)
  (setq ce--compiler-arguments "")
  (setq ce--execution-arguments "")
  (setq ce--execution-input "")

  (when ce--project-dir
    (with-demoted-errors "compiler-explorer--cleanup: delete-directory: %s"
      (delete-directory ce--project-dir t)))
  (setq ce--project-dir nil)

  (when ce-mode
    (ce-mode -1)))

(defun ce--cleanup (&optional skip-save-session)
  "Kill current session.
If SKIP-SAVE-SESSION is non-nil, don't attempt to save the last session."
  (unless ce--cleaning-up
    (let ((ce--cleaning-up t))
      (ce--cleanup-1 skip-save-session))))


;; Source<->ASM overlays

(defun ce--overlay-bg-base (percent &optional lighter)
  "Get the color for overlay background, PERCENT darker from default.
If LIGHTER is non-nil then the color is lighter instead."
  (when-let* ((bg (face-background 'default nil t)))
    (unless (string= bg "unspecified-bg")
      (pcase-let*
          ((`(,h ,s ,l) (apply #'color-rgb-to-hsl (color-name-to-rgb bg)))
           (`(_ _ ,l2)  (if lighter (color-lighten-hsl h s l percent)
                          (color-darken-hsl h s l percent))))
        (when (= l l2)
          (setq l2 (+ l (* 0.01 percent (if lighter 1 -1)))))
        (apply #'color-rgb-to-hex (color-hsl-to-rgb h s l2))))))

(defcustom ce-overlays '(46 28 17 10 6)
  "List for controlling how source<->ASM mapping overlays are displayed.

For each source line that maps to an ASM block, a single element is
taken from this list.  The element says how to display the overlay for
the mapping.  When the end of the list is reached, the elements are
taken from the beginning again until all source lines are processed.

Each element can be one of:

A face - this face will be used for the overlay.

A number - a face is synthesized for the overlay, with the background
color being the background color of the default face, darkened by this
many percent.

A cons (\\='lighten . NUMBER) - similarly, a face is synthesized, but
the background color is lighter by this many percent, not darker.

Note: if the default face has unspecified background color, then the
overlays will be invisible if using the darken/lighten option."
  :type '(repeat
          (choice face
                  (integer :tag "Darken percentage")
                  (cons :tag "Lighten percentage" (const lighten)
                        integer))))

(defface ce-cursor-entered
  `((t :weight bold))
  "Face used for overlays containing the point.")

(defcustom ce-source-to-asm-mappings t
  "If non-nil, decorate the source and ASM buffers.
The added overlays show which portion of source code maps to ASM
instructions.  Calling `compiler-explorer-jump' when point is
inside one of these colored blocks jumps to and highlights the
corresponding overlay in the other buffer."
  :type 'boolean)

(defun ce--cursor-entered (overlays face)
  "Temporarily highlight all entered OVERLAYS using FACE as base face."
  (dolist (ov overlays)
    (overlay-put ov 'face `(:inherit (ce-cursor-entered ,face)))))

(defun ce--cursor-left (overlays face)
  "Unhighlight OVERLAYS that were left, restoring FACE as their face."
  (dolist (ov overlays)
    (overlay-put ov 'face face)))

(defun ce--build-overlays (regions)
  "Add source<->ASM mapping overlays in REGIONS.
REGIONS should be a list of conses (LINE . POINTS), where LINE is
the line number in source buffer, and POINTS is a list of points
that are inside lines in the ASM buffer that map to this source
line."
  (with-current-buffer ce--compiler-buffer
    (remove-overlays nil nil 'ce--overlay t))
  (with-current-buffer ce--buffer
    (remove-overlays nil nil 'ce--overlay t))

  (setq regions (sort regions #'car-less-than-car))

  (let* ((faces (or ce-overlays '(default)))
         face
         source-overlay asm-overlays
         prev-ov
         (make-cursor-sensor-functions
          (lambda (ov face)
            (list
             (lambda (_window _pos kind)
               (let* ((siblings
                       (overlay-get ov 'ce--overlay-group))
                      (target (overlay-get
                               (overlay-get ov 'ce--target)
                               'ce--overlay-group))
                      (ovs (cl-delete-duplicates
                            (remq nil
                                  (append siblings target)))))
                 (pcase kind
                   ('entered (ce--cursor-entered ovs face))
                   ('left (ce--cursor-left ovs face)))))))))
    (pcase-dolist (`(,line-num . ,points-in-asm) regions)
      (setq face (car faces))
      (pcase face
        ((pred integerp)
         (setq face `(:background ,(ce--overlay-bg-base face) :extend t)))
        (`(,'lighten . ,(and (pred integerp) value))
         (setq face `(:background ,(ce--overlay-bg-base value t) :extend t))))
      (setq faces (append (cdr faces) (list face)))
      (setq asm-overlays nil source-overlay nil)

      (with-current-buffer ce--buffer
        (save-excursion
          (save-restriction
            (widen)
            (goto-char (point-min))
            (forward-line (1- line-num))
            (let ((ov (make-overlay (line-beginning-position)
                                    (line-beginning-position 2))))
              (overlay-put ov 'ce--overlay t)
              (overlay-put ov 'ce--overlay-group (list ov))
              (overlay-put ov 'cursor-sensor-functions
                           (funcall make-cursor-sensor-functions ov face))
              (overlay-put ov 'face face)
              (overlay-put ov 'priority -100)
              (setq source-overlay ov))))
        (cursor-sensor-mode +1))

      (with-current-buffer ce--compiler-buffer
        (dolist (pt points-in-asm)
          (goto-char pt)
          (setq prev-ov (car asm-overlays))
          (cond
           ;; Merge adjacent overlays
           ((and prev-ov (= (overlay-end prev-ov)
                            (line-beginning-position)))
            (move-overlay prev-ov (overlay-start prev-ov)
                          (line-beginning-position 2)))
           ((and prev-ov (= (overlay-start prev-ov)
                            (line-beginning-position 2)))
            (move-overlay prev-ov (line-beginning-position)
                          (overlay-end prev-ov)))
           (t
            (let ((ov (make-overlay (line-beginning-position)
                                    (line-beginning-position 2))))
              (overlay-put ov 'ce--overlay t)
              (overlay-put ov 'ce--target source-overlay)
              (overlay-put ov 'cursor-sensor-functions
                           (funcall make-cursor-sensor-functions ov face))
              (overlay-put ov 'face face)
              (overlay-put ov 'priority -100)

              (push ov asm-overlays)))))
        (cursor-sensor-mode +1))

      (setq asm-overlays (seq-sort-by #'overlay-start #'< asm-overlays))
      (dolist (ov asm-overlays)
        (overlay-put ov 'ce--overlay-group asm-overlays))
      (overlay-put source-overlay 'ce--target (car asm-overlays)))))


;; Stuff/hacks for integration with other packages

(defcustom ce-make-temp-file t
  "If non-nil, make a temporary file/dir for a `compiler-explorer' session.
This is required for integration with some other packages, for
example `compilation-mode' - with this, you can navigate to
errors in the source buffer by clicking on the links in compiler
output buffer.

This also sets up a transient project for the source buffer, so
you can use packages that require one.

When the session is killed, the temporary directory is deleted."
  :type 'boolean)

(defvar ce--project-dir nil)
(defun ce--project-find-function (_dir)
  "Return project with a temporary directory in a compiler explorer session."
  (and ce--project-dir `(transient . ,ce--project-dir)))

(defvar ce--filename-regexp "<source>\\|\\(example[.][^.]+$\\)")
(defun ce--compilation-parse-errors-filename
    (filename)
  "Wrapper for parsing FILENAME in compiler output buffer.
This allows navigating to errors in source code from that buffer."
  (and-let* ((fname (buffer-file-name (get-buffer ce--buffer)))
             ((string-match-p ce--filename-regexp filename)))
    (file-name-nondirectory fname)))

(defcustom ce-document-opcodes t
  "If non-nil, provide documentation for opcodes in ASM buffers.
This uses `eldoc' to output documentation for opcodes at point in
the minibuffer and separate help buffers."
  :type 'boolean)

(defun ce--compilation-eldoc-documentation-function (callback)
  "Call CALLBACK with the documentation for opcode at point.
This is eldoc function for compiler explorer."
  (when-let* ((opcode (thing-at-point 'symbol)))
    (ce--asm-opcode-doc
     (plist-get ce--compiler-data :instructionSet)
     opcode
     (pcase-lambda ((map :tooltip))
       (funcall callback
                (with-temp-buffer
                  (text-mode)
                  (insert tooltip)
                  (fill-paragraph)
                  (buffer-string))
                :thing opcode)))))


;; Session management

(defcustom ce-sessions-file
  (expand-file-name "compiler-explorer" user-emacs-directory)
  "File where sessions are persisted."
  :type 'file)

(defvar ce--session-ring
  (let ((ring (list)))
    (ignore-errors
      (with-temp-buffer
        (insert-file-contents ce-sessions-file)
        (let ((elts (read (current-buffer)))
              version)
          (if (and (consp elts) (integerp (car elts)))
              (setq version (car elts) elts (cdr elts))
            (setq version 0))
          (when (> version 1)
            (error "Session file is incompatible"))
          (dolist (e (nreverse elts))
            (setq version (plist-get e :version))
            (when (and version (> version 1))
              (setq e nil))
            (when e
              (push e ring))))))
    ring))

(defun ce--current-session ()
  "Serialize current session as plist."
  `(
    :version 1
    :lang-name ,(plist-get ce--language-data :name)
    :compiler ,(plist-get ce--compiler-data :id)
    :libs ,(mapcar (pcase-lambda (`(,id ,vid ,_)) (cons id vid))
                   ce--selected-libraries)
    :tools ,(mapcar (pcase-lambda (`(,id ,_ ,args ,stdin))
                      (list id args stdin))
                    ce--selected-tools)
    :args ,ce--compiler-arguments
    :exe-args ,ce--execution-arguments
    :input ,ce--execution-input
    :source ,(with-current-buffer (get-buffer ce--buffer)
               (buffer-substring-no-properties (point-min) (point-max)))
    :layout ,(unless noninteractive (ce--window-layout))))

(defun ce--stringize-session (session)
  "Stringify a saved SESSION.
The return value is a helpful human-readable string that
describes the session contents."
  (format "%s: %s" (plist-get session :lang-name)
          (with-temp-buffer
            (insert (string-trim (plist-get session :source)))
            (goto-char (min (point-max) 500))
            (concat (buffer-substring-no-properties (point-min) (point))
                    (unless (eobp) "...")))))

(defun ce--session-alist ()
  "Get an alist of the sessions.
The car of each element will be a human readable string for the
session.  The cdr will be a cons (SESSION-DATA . INDEX-IN-RING)."
  (cl-loop
   for session in ce--session-ring
   for i from 0
   collect (list (ce--stringize-session session) session i)))

(defcustom ce-restore-layouts t
  "Restore window layouts from previous sessions."
  :type 'boolean)

(defun ce--restore-session (session)
  "Restore serialized SESSION.
It must have been created with `compiler-explorer--current-session'."
  (pcase-let
      (((map :version :lang-name :compiler :libs :tools :args :exe-args :input
             :source :layout)
        session))
    (or version (setq version 0))
    (when (> version 1)
      (error "Don't know how to restore session version %s" version))
    (pcase-dolist (`(,sym ,val ,pred) `((version ,version integerp)
                                        (lang-name ,lang-name stringp)
                                        (compiler ,compiler stringp)
                                        (libs ,libs listp)
                                        (tools ,tools listp)
                                        (args ,args stringp)
                                        (exe-args ,exe-args stringp)
                                        (input ,input stringp)
                                        (source ,source stringp)
                                        (layout ,layout
                                                (lambda (obj)
                                                  (or (null obj)
                                                      (symbolp obj)
                                                      (consp obj)
                                                      (vectorp obj))))))
      (unless (funcall pred val)
        (error "Invalid %S: %s" sym val)))
    (dolist (elt libs)
      (unless (and (consp elt)
                   (stringp (car elt))
                   (stringp (cdr elt)))
        (error "Invalid library: %s" elt)))
    (dolist (elt tools)
      (unless (and (listp elt)
                   (= 3 (length elt))
                   (cl-every #'stringp elt))
        (error "Invalid tool: %s" elt)))

    (let ((ce--inhibit-request t))
      (ce-new-session lang-name compiler)
      (with-current-buffer (get-buffer ce--buffer)
        (let ((inhibit-modification-hooks t))
          (erase-buffer)
          (insert source)
          (set-buffer-modified-p nil)))
      (pcase-dolist (`(,id . ,vid) libs)
        (ce-add-library id vid))
      (pcase-dolist (`(,id ,args ,stdin) tools)
        (ce-add-tool id)
        (ce-set-tool-args id args)
        (ce-set-tool-input id stdin))
      (ce-set-compiler-args args)
      (ce-set-execution-args exe-args)
      (ce-set-input input)
      (when (and layout ce-restore-layouts)
        (ce-layout layout)))
    (ce--request-async)
    (ce--define-menu)))

(defun ce--save-sessions ()
  "Save all sessions to a file."
  (remove-hook 'kill-emacs-hook #'ce--save-sessions)
  (let ((current-session (and (ce-active-p) (ce--current-session))))
    (when current-session
      (push current-session ce--session-ring))
    (with-temp-file ce-sessions-file
      (insert ";; Auto-generated file; don't edit -*- mode: lisp-data -*-\n")
      (let ((print-length nil)
            (print-level nil))
        (print
         (cons 1                        ;version
               ce--session-ring)
         (current-buffer))))))


;; User commands & functions

(defun ce-active-p ()
  "Return non-nil if we're in a `compiler-explorer' session."
  (bufferp (get-buffer ce--buffer)))

(defun ce-current-session ()
  "Return current session as a plist."
  (unless (ce-active-p)
    (error "Not in a `compiler-explorer' session"))
  (ce--current-session))

(defvar ce-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map [remap display-local-help] #'eldoc-doc-buffer)
    map)
  "Keymap used in all compiler explorer buffers.")

(define-minor-mode ce--local-mode
  "Minor mode used in all compiler explorer buffers."
  :interactive nil
  :lighter ""
  (add-hook 'kill-buffer-hook #'ce--cleanup nil t)
  (add-hook 'project-find-functions #'ce--project-find-function nil t)

  (when ce--project-dir
    (setq-local default-directory ce--project-dir))

  (pcase (buffer-name)
    ((pred (equal ce--buffer))
     (setq header-line-format `(:eval (ce--header-line-format-source)))
     (add-hook 'after-change-functions #'ce--schedule-compilation nil t))
    ((pred (equal ce--compiler-buffer))
     (setq header-line-format `(:eval (ce--header-line-format-compiler)))
     (setq truncate-lines t)           ;Make the ASM view more like godbolt.org
     (when ce-document-opcodes
       (add-hook 'eldoc-documentation-functions
                 'ce--compilation-eldoc-documentation-function nil t)
       (setq-local eldoc-documentation-function 'eldoc-documentation-compose)
       (eldoc-mode +1)))
    ((pred (equal ce--output-buffer))
     (setq-local compile-command '(progn (compiler-explorer--request-async)
                                         "true")
                 compilation-arguments nil
                 compilation-parse-errors-filename-function
                 #'ce--compilation-parse-errors-filename))
    ((pred (equal ce--exe-output-buffer))
     (setq header-line-format `(:eval (ce--header-line-format-executor))))
    ((guard (ce--tool-id))
     (setq-local compile-command '(progn (compiler-explorer--request-async)
                                         "true")
                 compilation-arguments nil
                 compilation-parse-errors-filename-function
                 #'ce--compilation-parse-errors-filename)
     (setq header-line-format `(:eval (ce--header-line-format-tool))))))

(defun ce--local-mode-maybe-enable ()
  "Enable `compiler-explorer--local-mode' if required."
  (when (memq (current-buffer)
              (cl-list* (get-buffer ce--buffer)
                        (get-buffer ce--compiler-buffer)
                        (get-buffer ce--output-buffer)
                        (get-buffer ce--exe-output-buffer)
                        (mapcar #'cadr ce--selected-tools)))
    (ce--local-mode +1)))

(define-globalized-minor-mode ce-mode
  ce--local-mode
  ce--local-mode-maybe-enable
  :lighter " CE"
  :keymap ce-mode-map
  :require 'compiler-explorer
  (add-hook 'kill-emacs-hook #'ce--save-sessions)
  (unless ce-mode
    (ce--cleanup)))

(defun ce-show-output ()
  "Show compiler stdout&stderr buffer."
  (interactive)
  (unless (ce-active-p)
    (error "Not in a `compiler-explorer' session"))
  (display-buffer ce--output-buffer))

(defvar ce-params-change-hook nil
  "Hook called when parameters change.
Each function is called with two arguments: WHAT and VALUE.  WHAT
is a symbol, either:
 - `input'
 - `compiler'
 - `compiler-args'
 - `execution-args'
 - `tool-args'
 - `tool-input'

VALUE is the new value, a string; or a cons cell (ID . STRING) for
tool-* changes.")

(defun ce-jump (&optional which)
  "Jump to corresponding ASM block or source code line.
From source buffer, jump to the first ASM block for the line at
point.  From ASM buffer, jump to the source buffer and line for
the instruction at point.

From Lisp, WHICH is the index of the block to jump to (modulo the
number of blocks for the source code line associated with point).

Interactively, with a non-numeric prefix argument, jumps to the
NEXT region that maps to this source line, or to the source line
itself.  Thus, repeatedly calling this command with non-numeric
prefix argument will go through all related ASM blocks for one
source code block.

With a numeric prefix argument, jumps to the Nth ASM block for
the same source line."
  (interactive "P")
  (unless (ce-active-p)
    (error "Not in a `compiler-explorer' session"))
  (if-let* ((ov (cl-find-if
                 (lambda (ov) (overlay-get ov 'ce--overlay))
                 (overlays-at (point)))))
      (let* ((group (overlay-get ov 'ce--overlay-group))
             (index-of-this-ov (cl-position ov group))
             (requested-within-group
              (% (if (numberp which) (1- which) (1+ index-of-this-ov))
                 (length group)))
             (target-ov (if (or (null which)
                                (and (not (numberp which))
                                     ;; Are we in the last ASM block for this
                                     ;; line?
                                     (= index-of-this-ov (1- (length group)))))
                            ;; Jump to the other buffer, e.g. source from ASM
                            (overlay-get ov 'ce--target)
                          (nth requested-within-group group))))
        (setq group (overlay-get target-ov 'ce--overlay-group))

        (when (null which)
          (setq target-ov
                (car (seq-sort-by (lambda (ov)
                                    (with-current-buffer (overlay-buffer ov)
                                      (abs (- (overlay-start ov) (point)))))
                                  #'< group))))

        (pop-to-buffer (overlay-buffer target-ov))
        (goto-char (overlay-start target-ov))

        ;; Pulse it later, as `cursor-sensor-functions' might trigger right
        ;; after we quit this function (due to point movement), and they might
        ;; change the overlay's face.
        (run-with-timer 0.0 nil #'pulse-momentary-highlight-overlay target-ov)

        (message "%s block %d/%d"
                 (if (eq (current-buffer)
                         (get-buffer ce--buffer))
                     "Source" "ASM")
                 (1+ (cl-position target-ov group))
                 (length group)))
    (error "No corresponding ASM or source code block at point")))

(defun ce-browse-opcode-documentation (opcode)
  "Browse documentation for OPCODE in external browser.
This looks up the URL for the specific opcode docs in the
compiler-explore API and navigates to it.  Interactively, opcode is the
symbol at point.  With a prefix argument, a symbol is read from the
minibuffer."
  (interactive
   (and (or (ce-active-p) (user-error "Not in a `compiler-explorer' session"))
        (list
         (if current-prefix-arg
             (read-from-minibuffer "Show opcode documentation: " )
           (or (thing-at-point 'symbol)
               (user-error "There is no symbol at point"))))))
  (unless (ce-active-p)
    (error "Not in a `compiler-explorer' session"))
  (unless (ce--asm-opcode-doc
           (plist-get ce--compiler-data :instructionSet)
           opcode
           (pcase-lambda ((map :url)) (browse-url-xdg-open url))
           'sync)
    (error "No documentation for %s" opcode)))

(defun ce-set-input (input)
  "Set the input to use as stdin for execution to INPUT, a string."
  (interactive (list (if (ce-active-p)
                         (read-from-minibuffer "Stdin: " ce--execution-input)
                       (user-error "Not in a `compiler-explorer' session"))))
  (unless (ce-active-p)
    (error "Not in a `compiler-explorer' session"))
  (setq ce--execution-input input)
  (ce--request-async)
  (run-hook-with-args 'ce-params-change-hook 'input input))

(defvar ce-set-compiler-args-history nil
  "Minibuffer history for `compiler-explorer-set-compiler-args'.")

(defun ce-set-compiler-args (args)
  "Set compilation arguments to the string ARGS and recompile."
  (interactive (list (if (ce-active-p)
                         (read-from-minibuffer
                          "Compiler arguments: "
                          ce--compiler-arguments
                          nil nil 'ce-set-compiler-args-history)
                       (user-error "Not in a `compiler-explorer' session"))))
  (unless (ce-active-p)
    (error "Not in a `compiler-explorer' session"))
  (setq ce--compiler-arguments args)
  (ce--request-async)
  (run-hook-with-args 'ce-params-change-hook 'compiler-args args))

(defun ce-set-execution-args (args)
  "Set execution arguments to the string ARGS and recompile."
  (interactive (list (if (ce-active-p)
                         (read-from-minibuffer "Execution arguments: "
                                               ce--execution-arguments)
                       (user-error "Not in a `compiler-explorer' session"))))
  (unless (ce-active-p)
    (error "Not in a `compiler-explorer' session"))
  (setq ce--execution-arguments args)
  (ce--request-async)
  (run-hook-with-args 'ce-params-change-hook 'execution-args args))

(defun ce-set-compiler (name-or-id)
  "Select compiler NAME-OR-ID for current session.
Interactively, prompts for the name of a compiler.  With a prefix
argument, prompts only for the name of a compiler that supports
execution."
  (interactive
   (list
    (and
     (or (ce-active-p) (user-error "Not in a `compiler-explorer' session"))
     (or
      (get-text-property (point) 'ce-compiler-id)
      (let* ((lang ce--language-data)
             (default (plist-get lang :defaultCompiler))
             (compilers
              (seq-filter
               (pcase-lambda (`(_ _ ,supports-execute ,lang-id))
                 (and
                  ;; Only compilers for current language
                  (string= lang-id (plist-get lang :id))
                  (or (not current-prefix-arg)
                      (eq t supports-execute))))
               (mapcar
                (pcase-lambda ((map :name :id :supportsExecute :lang))
                  (list name id supportsExecute lang))
                (ce--compilers)))))
        (completing-read (concat "Compiler"
                                 (when current-prefix-arg " (with execution)")
                                 ": ")
                         ;; Note: keep PREDICATE nil to work around some subtle
                         ;; bugs in `test-completion' (gh#6)
                         compilers nil t
                         (car (cl-find default compilers
                                       :test #'string= :key #'cadr))))))))
  (unless (ce-active-p)
    (error "Not in a `compiler-explorer' session"))
  (pcase-let*
      (((map (:id lang-id) :defaultCompiler) ce--language-data)
       (name-or-id (or name-or-id defaultCompiler))
       (compiler-data (seq-find
                       (pcase-lambda ((map :id :name :lang))
                         (and (member name-or-id (list id name))
                              (string= lang lang-id)))
                       (ce--compilers))))
    (unless compiler-data
      (error "No compiler %S for lang %S" name-or-id lang-id))
    (setq ce--compiler-data compiler-data)
    (with-current-buffer (get-buffer ce--compiler-buffer)
      (ce--request-async)

      (pop-to-buffer (current-buffer))

      (ce--define-menu)

      (run-hook-with-args 'ce-params-change-hook
                          'compiler (plist-get compiler-data :name)))))

(defun ce-add-library (id version-id)
  "Add library ID with VERSION-ID to current compilation."
  (interactive
   (let* ((lang (or (and (ce-active-p)
                         (plist-get ce--language-data :id))
                    (user-error "Not in a `compiler-explorer' session")))
          (candidates (cl-reduce #'nconc
                                 (mapcar
                                  (pcase-lambda ((map :name :id :versions))
                                    (seq-map
                                     (pcase-lambda ((map :version (:id vid)))
                                       `(,(concat name " " version) ,id ,vid))
                                     versions))
                                  (ce--libraries lang))))
          (res (completing-read
                "Add library: " candidates
                ;; Ignore libraries that are already added.
                (pcase-lambda (`(,_ ,id ,_))
                  (null (assoc id ce--selected-libraries)))
                t)))
     (cdr (assoc res candidates))))
  (unless (ce-active-p)
    (error "Not in a `compiler-explorer' session"))
  (let* ((libentry
          (cl-find id (ce--libraries (plist-get ce--language-data :id))
                   :key (lambda (l) (plist-get l :id))
                   :test #'string=))
         (version-entry
          (cl-find version-id (plist-get libentry :versions)
                   :key (lambda (v) (plist-get v :id))
                   :test #'string=)))
    (unless libentry
      (error "Library with id %S is invalid for the current language" id))
    (unless version-entry
      (error "Version id %S is invalid for library %S" version-id id))
    (push (list id version-id libentry) ce--selected-libraries)
    (ce--request-async))

  ;; Repopulate list of libraries to remove
  (ce--define-menu))

(defun ce-remove-library (id)
  "Remove library with ID.
It must have previously been added with
`compiler-explorer-add-library'."
  (interactive
   (if (ce-active-p)
       (let* ((libs-by-name
               (mapcar (pcase-lambda (`(,_ ,_ ,entry))
                         (cons (plist-get entry :name) entry))
                       ce--selected-libraries))
              (choice
               (completing-read "Remove library: "
                                (mapcar #'car libs-by-name) nil t))
              (entry (cdr (assoc choice libs-by-name))))
         (list (plist-get entry :id)))
     (user-error "Not in a `compiler-explorer' session")))
  (unless (ce-active-p)
    (error "Not in a `compiler-explorer' session"))
  (setq ce--selected-libraries
        (delq (assoc id ce--selected-libraries) ce--selected-libraries))
  (ce--request-async)

  ;; Repopulate list of libraries to remove
  (ce--define-menu))

(defvar ce-dedicate-windows)

(defvar ce-tool-added-hook nil
  "Hook called after a tool is added.
Each function is called with one argument, the tool id.
The tool's buffer is active when this hook runs.")

(defun ce-add-tool (id)
  "Add tool ID to the current compilation."
  (interactive
   (let* ((lang (or (and (ce-active-p)
                         (plist-get ce--language-data :id))
                    (user-error "Not in a `compiler-explorer' session")))
          (candidates (mapcar
                       (lambda (id) (cons (ce--tool-name id) id))
                       (mapcar #'car (ce--tools lang))))
          (res (completing-read
                "Add tool: " candidates
                ;; Ignore tools that are already added.
                (lambda (id) (null (assoc id ce--selected-tools)))
                t))
          (res (map-elt candidates res)))
     (list res)))
  (unless (ce-active-p)
    (error "Not in a `compiler-explorer' session"))

  (when (assoc id ce--selected-tools)
    (error "Tool %s already added" id))

  (let ((buf (generate-new-buffer
              (format ce--tool-buffer-format (ce--tool-name id))))
        window)
    (push (list id buf "" "") ce--selected-tools)
    (unless noninteractive
      (setq window (display-buffer buf))
      (when (and (windowp window) ce-dedicate-windows)
        (set-window-dedicated-p window t)))
    (with-current-buffer buf
      (compilation-mode)
      (ce--local-mode)
      (setq buffer-read-only t)
      (setq buffer-undo-list t)

      (run-hook-with-args 'ce-tool-added-hook id)))

  (ce--request-async)

  ;; Repopulate list of tools to remove
  (ce--define-menu))

(defvar ce-tool-removed-hook nil
  "Hook called after a tool is removed.
Each function is called with one argument, the tool id.")

(defun ce-remove-tool (id)
  "Remove tool ID from the current compilation."
  (interactive
   (if (ce-active-p)
       (let* ((candidates (mapcar
                           (lambda (id) (cons (ce--tool-name id) id))
                           (mapcar #'car ce--selected-tools)))
              (res (completing-read "Remove tool: " candidates nil t))
              (res (map-elt candidates res)))
         (list res))
     (user-error "Not in a `compiler-explorer' session")))
  (unless (ce-active-p)
    (error "Not in a `compiler-explorer' session"))

  (if-let* ((entry (cdr (assoc id ce--selected-tools)))
            (buf (car entry)))
      (progn
        (setq ce--selected-tools
              (delq (assoc id ce--selected-tools) ce--selected-tools))
        (with-current-buffer buf
          (dolist (window (window-list))
            (with-selected-window window
              (when (and (eq (window-buffer) buf)
                         (window-parent window))
                (delete-window window))))
          (let ((kill-buffer-hook
                 (remq #'ce--cleanup kill-buffer-hook)))
            (kill-buffer (current-buffer)))))
    (error "Tool is not added: %s" id))

  (ce--request-async)
  ;; Repopulate list of tools to remove
  (ce--define-menu)

  (run-hook-with-args 'ce-tool-removed-hook id))

(defvar ce--tool-context nil
  "Let-bound variable that contains the tool id value for various commands.
This is used so that we don't query the user for ID when they obviously
want to perform some command for a specific tool.")

(defvar ce-set-tool-args-history nil
  "Minibuffer history for `compiler-explorer-set-tool-args'.")

(defun ce-set-tool-args (id args)
  "Set the arguments of tool with ID to string ARGS."
  (interactive
   (and
    (or (ce-active-p)
        (user-error "Not in a `compiler-explorer' session"))
    (let* ((tools (or (mapcar #'car ce--selected-tools)
                      (user-error "No tools selected")))
           (tool
            (or ce--tool-context
                (if (cdr tools)
                    (completing-read
                     "Set args for tool: " tools nil t nil nil (ce--tool-id))
                  (car tools))))
           (args (read-from-minibuffer
                  (format "Set arguments for tool '%s': " tool)
                  (caddr (assoc tool ce--selected-tools))
                  nil nil 'ce-set-tool-args-history)))
      (list tool args))))
  (unless (ce-active-p)
    (error "Not in a `compiler-explorer' session"))

  (if-let* ((tool-data (assoc id ce--selected-tools)))
      (setf (caddr tool-data) args)
    (error "Tool %S not added" id))

  (ce--request-async)

  (run-hook-with-args 'ce-params-change-hook 'tool-args (cons id args)))

(defun ce-set-tool-input (id input)
  "Set the standard input of tool with ID to string INPUT."
  (interactive
   (and
    (or (ce-active-p) (user-error "Not in a `compiler-explorer' session"))
    (let* ((tools (or (mapcar #'car ce--selected-tools)
                      (user-error "No tools selected")))
           (lang (plist-get ce--language-data :id))
           (tool
            (or ce--tool-context
                (if (cdr tools)
                    (completing-read
                     "Set stdin for tool: " tools nil t nil nil (ce--tool-id))
                  (car tools))))
           (tool-data (map-elt (ce--tools lang) tool)))
      (unless (plist-get tool-data :allowStdin)
        (user-error "Tool %S does not support setting stdin" tool))
      (list tool (read-from-minibuffer
                  (format "Set input for tool '%s': " tool)
                  (cadddr (assoc tool ce--selected-tools)))))))
  (unless (ce-active-p)
    (error "Not in a `compiler-explorer' session"))

  (if-let* ((tool-data (assoc id ce--selected-tools)))
      (setf (cadddr tool-data) input)
    (error "Tool %S not added" id))

  (ce--request-async)

  (run-hook-with-args 'ce-params-change-hook 'tool-input (cons id input)))

(defun ce-previous-session (&optional nth)
  "Restore previous session.
With optional argument NTH (default 0), restore NTH previous
session.

Interactively, when called with a prefix argument, prompts for a
session to restore, displaying the session contents and allowing
to choose one via `completing-read'.

When called without a prefix argument, this will cycle between
all the previous sessions one by one."
  (interactive
   (when current-prefix-arg
     (let* ((sessions-alist (ce--session-alist))
            (choice
             (completing-read "Restore session: " sessions-alist nil t)))
       (cddr (assoc choice sessions-alist)))))
  (unless ce--session-ring
    (error "No previous sessions"))
  (unless nth
    (setq nth 0))
  (let ((prev (nth nth ce--session-ring))
        (current (and (ce--session-savable-p) (ce--current-session)))
        (success nil))
    (setq ce--session-ring (seq-remove-at-position ce--session-ring nth))

    (condition-case err
        (prog1 t
          (unwind-protect
              (let ((ce--session-ring nil))
                ;; Override the ring to not mess with it.
                (ce--restore-session prev)
                (setq success t))
            ;; Insert last session into the ring as the *oldest* item.  We have
            ;; to do this, otherwise we would only be able to cycle between two
            ;; sessions.
            (when current
              (add-to-list 'ce--session-ring current 'append))

            ;; Redefine the menu with the ring updated (for "Restore session"
            ;; submenu)
            (when success
              (ce--define-menu))))
      (error
       (ce--cleanup 'skip-save-session)
       (display-warning
        'compiler-explorer
        (format "Previous session is corrupt: %s" (error-message-string err))
        :warning)
       nil))))

(defun ce-discard-session (&optional indices interactive)
  "Kill the current session and forget about it.
If INDICES is non-nil, it should be a list of ring indices.  If
provided, the sessions at these indices will be removed from the
ring (0 = newest).  If INDICES contains nil, then the current
session is killed and not saved to the ring.

If INTERACTIVE, prompt for confirmation.

Interactively, discard the current session.  With a prefix
argument, prompt for sessions to discard."
  (interactive
   (cond
    ((and (not (ce-active-p)) (null ce--session-ring))
     (user-error "No sessions"))
    ((and (ce-active-p)
          (not current-prefix-arg))
     (list nil t))
    (t (let* ((sessions-alist (ce--session-alist))
              (choices
               (cl-loop
                with sessions = (append (list '(""))
                                        (and (ce-active-p)
                                             (list '("*current*")))
                                        (ce--session-alist))
                while (cdr sessions)
                for choice =
                (completing-read "Discard sessions (RET to finish): "
                                 sessions nil t nil nil "")
                until (string= choice "")
                collect choice
                do (setq sessions
                         (delq (assoc choice sessions)
                               sessions)))))
         (unless choices
           (user-error "No sessions selected"))
         (list
          (mapcar (lambda (choice) (caddr (assoc choice sessions-alist)))
                  choices)
          t)))))
  (let ((current (or (null indices) (memq nil indices))))
    (when (and current (not (ce-active-p)))
      (error "Not in a `compiler-explorer' session"))
    (if (and interactive (not (yes-or-no-p
                               (if (or (null indices) (equal indices '(nil)))
                                   "Discard this session? "
                                 (format
                                  "Discard %s session%s? "
                                  (length indices)
                                  (if (cdr indices) "s" ""))))))
        (user-error "Aborted")
      (setq indices (sort (delq nil indices) #'>))

      (mapc (lambda (index)
              (setq ce--session-ring
                    (seq-remove-at-position ce--session-ring index)))
            indices)

      (when current
        (ce--cleanup 'skip-save-session)
        (when ce--session-ring
          (ce-previous-session))))))

(defvar ce-layouts
  '((source . asm)
    (source . [asm output])
    (source [asm output] . exe)
    (source [asm output] . [exe [:tools]]))
  "List of layouts.

A layout can be either:

  - a symbol (one of `source', `asm', `output', `exe', `tool')
    means fill the available space with that buffer
  - a cons (left . right) - recursively apply layouts
    left and right after splitting available space horizontally
  - a vector [upper lower] - recursively apply layouts
    above and below after splitting available space vertically
  - a vector [:tools] - display all added tools vertically in the
    remaining space
  - a number, n - apply n-th layout in this variable")

(defcustom ce-default-layout 0
  "The default layout to use.
See `compiler-explorer-layouts' for available layouts."
  :type 'sexp)

(defvar ce--last-layout 0)

(defcustom ce-dedicate-windows t
  "Make all windows dedicated to their buffers.
If non-nil, all compiler explorer windows will be bound to the
buffers they are displaying via `set-window-dedicated-p' and
other, unrelated buffers will not be displayable in these
windows."
  :type 'boolean)

(defun ce-layout (&optional layout)
  "Layout current frame.
Interactively, applies layout defined in variable
`compiler-explorer-default-layout'.  When this command is called
repeatedly (`repeat'), it will cycle between all layouts in
`compiler-explorer-layouts'.

LAYOUT must be as described in `compiler-explorer-layouts'."
  (interactive
   (list
    (or (and (numberp current-prefix-arg) current-prefix-arg)
        (when (eq last-command #'ce-layout)
          (1+ ce--last-layout)))))
  (unless (ce-active-p)
    (error "Not in a `compiler-explorer' session"))
  (cl-labels
      ((override-window-buffer
         (window buffer)
         (set-window-buffer window buffer)
         (when ce-dedicate-windows
           (set-window-dedicated-p window t)))
       (do-it
         (spec)
         (pcase-exhaustive spec
           ('nil (when (window-parent) (delete-window)))
           ((and (pred numberp) n)
            (do-it (nth n ce-layouts)))
           ('source
            (override-window-buffer (selected-window) ce--buffer))
           ('asm
            (override-window-buffer (selected-window) ce--compiler-buffer))
           ('output
            (override-window-buffer
             (selected-window) (get-buffer ce--output-buffer)))
           ('exe
            (override-window-buffer
             (selected-window) (get-buffer ce--exe-output-buffer)))
           ((and 'tool (guard ce--selected-tools))
            (override-window-buffer
             (selected-window) (cadr (pop ce--selected-tools))))
           (`(,left . ,right)
            (let ((right-window (split-window-right)))
              (do-it left)
              (with-selected-window right-window
                (do-it right))))
           (`[,upper ,lower]
            (let ((lower-window (split-window-vertically)))
              (do-it upper)
              (with-selected-window lower-window
                (do-it lower))))
           (`[:tools]
            (let ((ce--selected-tools (copy-sequence ce--selected-tools)))
              (if ce--selected-tools
                  (if (cdr ce--selected-tools)
                      (do-it [tool [:tools]])
                    (do-it 'tool))
                (when (window-parent)
                  (delete-window))))))))
    (or layout (setq layout ce-default-layout))
    (when (numberp layout)
      (setq layout (% layout (length ce-layouts)))
      (setq ce--last-layout layout))
    (when (window-dedicated-p)
      (unless ce--local-mode
        (select-window (split-window-horizontally)))
      (set-window-dedicated-p (selected-window) nil))
    (delete-other-windows)
    (condition-case err
        (let ((ce--selected-tools (copy-sequence ce--selected-tools)))
          (do-it layout))
      (error (message "Could not apply layout %s: %s" layout err)))
    (balance-windows)))

(defun ce-load-example (example)
  "Load an example named EXAMPLE.
Interactively, this prompts for an example to load for the current language."
  (interactive
   (list
    (and (or (ce-active-p)
             (user-error "Not in a `compiler-explorer' session"))
         (completing-read "Load example: "
                          (ce--examples (plist-get ce--language-data :id))
                          nil t))))
  (unless (ce-active-p)
    (error "Not in a `compiler-explorer' session"))
  (if-let* ((lang (plist-get ce--language-data :id))
            (all (ce--examples lang))
            (data (cdr (assoc example all))))
      (with-temp-buffer
        (insert (plist-get (ce--example lang (plist-get data :file)) :file))
        (ce--replace-buffer-contents (get-buffer ce--buffer) (current-buffer)))
    (error "Unknown example %S" example)))

(defun ce-make-link (&optional open)
  "Save URL to current session in the kill ring and return it.
With an optional prefix argument OPEN, open that link in a browser."
  (interactive "P")
  (unless (ce-active-p)
    (error "Not in a `compiler-explorer' session"))
  (let* ((compiler
          `(
            :id ,(plist-get ce--compiler-data :id)
            :libs [,@(mapcar
                      (pcase-lambda (`(,id ,version ,_))
                        `(:id ,id :version ,version))
                      ce--selected-libraries)]
            :tools [,@(mapcar
                       (pcase-lambda (`(,id ,_ ,args ,stdin))
                         `(:id ,id
                               :args ,(seq-into (split-string-and-unquote args)
                                                'vector)
                               :stdin ,stdin))
                       ce--selected-tools)]
            :options ,ce--compiler-arguments
            :filters ,(ce--output-filters)))
         (state
          `(:sessions
            [(
              :id 1
              :language ,(plist-get ce--language-data :id)
              :source ,(with-current-buffer (get-buffer ce--buffer)
                         (buffer-string))
              :compilers [,compiler]
              :executors [
                          (
                           :arguments ,ce--execution-arguments
                           :compiler ,compiler
                           :stdin ,ce--execution-input)
                          ])]))
         (response
          (ce--request-sync
           "Generating shortlink" (ce--url "shortener")
           :method 'post
           :headers '(("Accept" . "application/json")
                      ("Content-Type" . "application/json"))
           :body (let ((json-object-type 'plist))
                   (json-encode state))))
         (url (plist-get response :url)))
    (message (kill-new url))
    (prog1 url (when open (browse-url-xdg-open url)))))

(defun ce-restore-from-link (url)
  "Restore a compiler-explorer session from the given URL.
URL should be a shortened compiler explorer URL, e.g. generated
by `compiler-explorer-make-link', or created by the website itself."
  (interactive "MRestore session from link: ")
  (pcase-let* (((cl-struct url filename) (url-generic-parse-url url))
               (shortlink
                (if (string-prefix-p "/z/" filename)
                    (substring filename 3)
                  (error "%s is not a valid compiler-explorer shortlink" url)))
               ((map (:sessions (seq session other-session)))
                (ce--request-sync (format "Fetching state from %s" url)
                                  (ce--url "shortlinkinfo" shortlink)))
               ((map :language
                     :source
                     (:compilers
                      (seq (map (:id compiler-id) :options :libs :tools)
                           other-compiler))
                     (:executors
                      (seq (map :arguments :stdin)
                           other-executor)))
                session)
               (ce--inhibit-request t))
    (ce-new-session language compiler-id)
    (seq-do (pcase-lambda ((and lib (map :id :version)))
              (if (and id version)
                  (ce-add-library id version)
                (display-warning 'compiler-explorer
                                 (format "Invalid library: %s" lib)
                                 :warning)))
            libs)
    (seq-do (pcase-lambda ((map :id :args :stdin))
              (ce-add-tool id)
              (if (or (listp args) (vectorp args))
                  (ce-set-tool-args id (string-join args ?\ ))
                (ce-set-tool-args id args))
              (unless (string-empty-p stdin)
                (ce-set-tool-input id stdin)))
            tools)
    (when options
      (ce-set-compiler-args options))
    (when arguments
      (ce-set-execution-args arguments))
    (when stdin
      (ce-set-input stdin))
    (with-current-buffer ce--buffer
      (erase-buffer)
      (insert source))
    (when other-session
      (display-warning
       'compiler-explorer
       (concat "The shortlink contains multiple sessions,"
               " but it's only possible to restore one. "
               "Ignoring the other sessions.")
       :warning))
    (when other-compiler
      (display-warning
       'compiler-explorer
       (concat "The shortlink contains multiple compilers,"
               " but it's only possible to restore one. "
               "Ignoring the other compilers.")
       :warning))
    (when other-executor
      (display-warning
       'compiler-explorer
       (concat "The shortlink contains multiple executors,"
               " but it's only possible to restore one. "
               "Ignoring the other executors.")
       :warning)))
  (ce--request-async))

(defvar ce-new-session-hook '(ce-layout)
  "Hook run after creating new session.
The source buffer is current when this hook runs.")

(defun ce-new-session-1 (lang &optional compiler interactive)
  "Start new session for LANG (name or id).
This is a subr of `compiler-explorer-new-session' that uses given
LANG, COMPILER, INTERACTIVE."
  (when-let* ((ent (cl-find lang (ce--languages)
                            :key (lambda (l) (plist-get l :id))
                            :test #'string=)))
    (setq lang (plist-get ent :name)))

  ;; Clean everything up
  (ce--cleanup)

  ;; Enter session mode
  (ce-mode +1)

  ;; Generate temporary directory if needed
  (setq ce--project-dir
        (and ce-make-temp-file (make-temp-file "compiler-explorer" 'dir)))

  ;; Generate all the buffers
  (pcase-dolist (`(,buf ,mode ,ro)
                 `((,ce--buffer fundamental-mode nil)
                   (,ce--compiler-buffer asm-mode t)
                   (,ce--output-buffer compilation-mode t)
                   (,ce--exe-output-buffer text-mode t)))
    (with-current-buffer (generate-new-buffer buf)
      (with-demoted-errors "compiler-explorer-new-session-1: %S"
        (funcall mode))
      (setq buffer-read-only ro)
      (setq buffer-undo-list ro)))

  ;; Do the rest of the initialization: set up the source buffer and set the
  ;; compiler.

  (pcase-let* ((lang-data (or (cl-find lang (ce--languages)
                                       :key (lambda (l) (plist-get l :name))
                                       :test #'string=)
                              (error "Language %S does not exist" lang)))
               ((map :extensions :id :example) lang-data))
    (setq ce--language-data lang-data)

    ;; Prefetch
    (ignore (ce--libraries id))
    (ignore (ce--examples id))

    (with-current-buffer ce--buffer
      ;; Find major mode by extension
      (cl-loop for ext across extensions
               for filename = (expand-file-name (concat "test" ext)
                                                default-directory)
               while (eq major-mode 'fundamental-mode)
               do (let ((buffer-file-name filename))
                    (with-demoted-errors "compiler-explorer--new-session-1: %S"
                      (set-auto-mode))))

      (insert example)
      (save-current-buffer
        (condition-case err
            (ce-set-compiler compiler)
          (error (if interactive
                     (call-interactively #'ce-set-compiler)
                   (signal (car err) (cdr err))))))

      (when ce--project-dir
        (setq buffer-file-name
              (expand-file-name (concat "source" (aref extensions 0))
                                ce--project-dir))
        (let ((save-silently t)) (save-buffer)))

      (ce--define-menu)

      (pop-to-buffer (current-buffer))
      (run-hooks 'ce-new-session-hook))))

(defun ce-new-session (lang &optional compiler)
  "Create a new compiler explorer session with language named LANG.
If COMPILER (name or id) is non-nil, set that compiler.

If a session already exists, it is killed and saved to the
session ring.

Always runs hooks in `compiler-explorer-new-session-hook' at the
end, with the source buffer as current.

If COMPILER is t, then use the default compiler for this
language, and if that fails, prompt the user to select another
compiler."
  (interactive
   (list (completing-read "Language: "
                          (mapcar (lambda (lang) (plist-get lang :name))
                                  (ce--languages))
                          nil t)
         t))
  (let (success)
    (unwind-protect
        (progn
          (let ((ce--inhibit-request t))
            (ce-new-session-1 lang
                              (if (eq compiler t) nil compiler)
                              (eq compiler t)))
          (ce--request-async)
          (setq success t))
      (unless success
        (ce--cleanup 'skip-save-session)))))

(defun ce-exit ()
  "Kill the current session."
  (interactive)
  (unless (ce-active-p)
    (error "Not in a `compiler-explorer' session"))
  (ce--cleanup))

(defvar ce-hook '()
  "Hook run at the end of `compiler-explorer'.
This hook can be used to run code regardless whether a session
was created/restored.")

;;;###autoload
(defun compiler-explorer ()
  "Open a compiler explorer session.
If a live session exists, just pop to the source buffer.
If there are saved sessions, restore the last one.
Otherwise, create a new session (`compiler-explorer-new-session').

The hook `compiler-explorer-hook' is always run at the end."
  (interactive)
  (let ((buffer (get-buffer ce--buffer)))
    (cond
     (buffer (pop-to-buffer buffer) (ce--request-async))
     ((and ce--session-ring (ce-previous-session)))
     (t (call-interactively #'ce-new-session))))
  (run-hooks 'ce-hook))

(provide 'compiler-explorer)
;;; compiler-explorer.el ends here

;; Local Variables:
;; indent-tabs-mode: nil
;; read-symbol-shorthands: (("ce-" . "compiler-explorer-"))
;; End:
