;;; lozenge.el --- Utility commands reachable through the ◊ lozenge -*- lexical-binding: t; -*-

;; Author: Pavel Popov
;; Keywords: convenience, tools

;;; Commentary:

;; A collection of jump-to-it commands inspired by eev, crux and GNU
;; Hyperbole.  Every command is named after the ◊ lozenge, so a note can
;; carry an executable sexp - (◊find-file 'velpa "lozenge.el") - and
;; `◊insert' types the ◊ and completes the rest.

;;; Code:

(require 'cl-lib)
(require 'rx)
(require 'seq)
(require 'subr-x)
(declare-function rxt-elisp-to-pcre "pcre2el")
(require 'url-parse)
(require 'shortdoc)
(require 'find-func)
(require 's)

(declare-function deadgrep "deadgrep")
(declare-function ack "ack")
(declare-function plz-see "plz-see")
(declare-function magit-show-commit "magit-diff")
(declare-function magit-status "magit-status")
(defvar deadgrep--search-type)
(defvar deadgrep--file-type)
(defvar plz-see-base-url)

(defgroup lozenge nil
  "Utility commands reachable through the ◊ lozenge."
  :group 'convenience)

(defcustom ◊repo-roots
  '((home . "~"))
  "Alist of roots under which a repository is looked up by name.
Each value is a directory holding repository subdirectories; the
first root containing the repository wins."
  :type '(alist :key-type symbol :value-type directory)
  :group 'lozenge)

(defcustom ◊doc-section-order 'reverse
  "How `◊doc' orders a feature's sections.
`reverse' puts the last section of the source file first: a Lisp file
defines primitives before the things that use them, so reading it
backwards leads with what a caller wants.  `source' keeps the file's
order.  Either way an explicit order set with (put FEATURE
\='◊doc-sections \='(SECTION ...)) is honoured first, and Other
comes last."
  :type '(choice (const reverse) (const source))
  :group 'lozenge)

(defcustom ◊github-org "foobar"
  "GitHub organisation assumed when a repository is named bare."
  :type 'string
  :group 'lozenge)

;;;; Internals

(defun ◊--name (thing)
  "Return THING as a string, whether it is a symbol or a string."
  (if (symbolp thing) (symbol-name thing) thing))

(defun ◊--repo-directory (repo)
  "Return the directory of REPO, searched across `◊repo-roots'.
Signal an error when no root holds REPO."
  (let* ((repo (◊--name repo))
         (dir (cl-loop for (_ . root) in ◊repo-roots
                       for candidate = (expand-file-name repo root)
                       when (file-directory-p candidate)
                       return candidate)))
    (or dir (user-error "Repository %s not found" repo))))

(defun ◊--find-file-or-switch (file)
  "Open FILE, selecting its window if FILE is already displayed."
  (let* ((buffer (find-file-noselect file))
         (window (get-buffer-window buffer 0)))
    (if window
        (select-window window)
      (switch-to-buffer buffer))))

(defun ◊--goto (line col)
  "Move point to LINE and COL, either of which may be nil."
  (when (and line (> line 0))
    (goto-char (point-min))
    (forward-line (1- line))
    (when (and col (> col 0)) (forward-char (1- col)))))

(defun ◊--files (dir)
  "Return the files tracked under DIR, as absolute paths."
  (process-lines "rg" "--files" (expand-file-name dir)))

(defun ◊--split-pattern (pattern)
  "Split PATTERN into a list (NAME LINE COL).
LINE and COL come from a trailing :LINE or :LINE:COL and are nil
when absent."
  (let ((parts (split-string pattern ":")))
    (list (car parts)
          (and (nth 1 parts) (string-to-number (nth 1 parts)))
          (and (nth 2 parts) (string-to-number (nth 2 parts))))))

(defun ◊--resolve-file (repo name)
  "Return the first file matching NAME in REPO.
When REPO is nil, use NAME as a path.  Signal an error if no file matches."
  (let* ((dir (if repo (◊--repo-directory repo) "/"))
         (subdir (expand-file-name name dir))
         (file (cond ((file-directory-p subdir) subdir)
                    ((null repo) name)
                    (t (seq-find (lambda (f) (string-search name f))
                                 (◊--files dir))))))
    (or file (user-error "File %s not found" name))))


;;;; Files
(defun ◊find-file (repo pattern)
  "Open the first file matching PATTERN in REPO.
PATTERN may carry a trailing :LINE or :LINE:COL, and point lands
there.  REPO is looked up across `◊repo-roots'."
  (interactive "sRepo: \nsFile: ")
  (pcase-let ((`(,name ,line ,col) (◊--split-pattern pattern)))
    (◊--find-file-or-switch (◊--resolve-file repo name))
    (◊--goto line col)))

(defun ◊read (repo pattern)
  "Return the contents of the first file matching PATTERN in REPO.
REPO is looked up across `◊repo-roots'; nil means PATTERN is a path.
A trailing :LINE reads from that one-based line through end of file.
An optional :COL after :LINE is ignored.  Read from disk without
visiting the file."
  (pcase-let ((`(,name ,line ,_) (◊--split-pattern pattern)))
    (with-temp-buffer
      (insert-file-contents (◊--resolve-file repo name))
      (◊--goto line nil)
      (buffer-substring-no-properties (point) (point-max)))))

(defun ◊elpa-find-file (pattern)
  "Open the file matching PATTERN in the elpa directory.
PATTERN may carry a trailing :LINE or :LINE:COL.  Error when two
versions of the same package match - the stale one has to go."
  (interactive "sFile: ")
  (pcase-let* ((`(,name ,line ,col) (◊--split-pattern pattern))
               (elpa-dir (expand-file-name "elpa" user-emacs-directory))
               (files (seq-filter (lambda (f)
                                    (and (string-search name f)
                                         (not (string-suffix-p ".elc" f))))
                                  (◊--files elpa-dir)))
               (pkgs (mapcar (lambda (f)
                               (let ((dir (cadr (split-string f "/elpa/"))))
                                 (replace-regexp-in-string
                                  "-[0-9].*?/.*\\'" "" dir)))
                             files))
               (dups (seq-filter (lambda (p)
                                   (> (cl-count p pkgs :test #'string=) 1))
                                 (seq-uniq pkgs))))
    (when dups
      (user-error "Multiple versions found for: %s — clean up %s"
                  (string-join dups ", ") elpa-dir))
    (unless files
      (user-error "File %s not found" name))
    (find-file (cl-first files))
    (◊--goto line col)))

(defun ◊recover-all-files (&optional dir)
  "Run `recover-file' for every file in DIR that has auto-save data.
DIR defaults to `default-directory'.  Candidates are found from
their auto-save files (#name#); `recover-file' prompts per file."
  (interactive)
  (let ((dir (expand-file-name (or dir default-directory))))
    (dolist (auto (directory-files dir t "\\`#.*#\\'"))
      (let* ((base (file-name-nondirectory auto))
             (orig (and (string-match "\\`#\\(.*\\)#\\'" base)
                        (expand-file-name (match-string 1 base) dir))))
        (when (and orig (file-exists-p orig))
          (condition-case err
              (recover-file orig)
            (error (message "Skipping %s: %s" orig (error-message-string err)))))))))


;;;; Searching

(defun ◊grep (repo term)
  "Grep REPO for the string TERM with `deadgrep'.

REPO is repository name (symbol or string), searched across
`◊repo-roots', not a full path.  TERM is a string to search for."
  (interactive "sRepo: \nsTerm: ")
  (let ((default-directory (◊--repo-directory repo)))
    (deadgrep term)))

(defun ◊grep-re (repo term)
  "Grep REPO for the regexp TERM with `deadgrep'.

REPO is repository name (symbol or string), searched across
`◊repo-roots', not a full path.  TERM is a string to search for."
  (interactive "sRepo: \nsTerm: ")
  (let ((default-directory (◊--repo-directory repo))
        (deadgrep--search-type 'regexp))
    (deadgrep term)))

(defun ◊grep-notes (term)
  "Grep the work notes for the string TERM."
  (interactive "sTerm: ")
  (let ((default-directory "~/VioNotes/"))
    (deadgrep term)))

(defun ◊ack-rx (expr &optional directory)
  "Run `ack' in DIRECTORY for EXPR, an `rx' form."
  (let ((pat (rxt-elisp-to-pcre (rx-to-string expr t))))
    (ack (format "ack %s" (shell-quote-argument pat)) directory)))


;;;; Git

(defun ◊show-commit (repo ref)
  "Show commit REF of REPO in Magit."
  (interactive "sRepo: \nsCommit: ")
  (let ((default-directory (◊--repo-directory repo)))
    (magit-show-commit ref)))

(defun ◊git-status (repo)
  "Show Magit status of REPO, a directory or a repository name symbol."
  (interactive (list (read-directory-name "Repository: ")))
  (magit-status (if (symbolp repo) (◊--repo-directory repo) repo)))


;;;; The web

(cl-defun ◊github-search (term &key (org ◊github-org) (repo nil))
  "Search GitHub code for TERM, narrowed to ORG and REPO."
  (interactive "sTerm: ")
  (let ((term (◊--name term))
        (org (and org (◊--name org)))
        (repo (and repo (◊--name repo))))
    (when org (setq term (format "org:%s %s" org term)))
    (when repo (setq term (format "repo:%s %s" repo term)))
    (browse-url (url-encode-url
                 (format "https://github.com/search?q=%s&type=code" term)))))

(cl-defun ◊github-repo (repo &key (org ◊github-org))
  "Open REPO on GitHub.
REPO may be a bare name or ORG/REPO; a bare name is qualified
with ORG."
  (interactive "sRepo: ")
  (let* ((repo (◊--name repo))
         (org (and org (◊--name org)))
         (path (if (or (null org) (string-search "/" repo))
                   repo
                 (format "%s/%s" org repo))))
    (browse-url (format "https://github.com/%s" path))))

(defun ◊shortcut-story (story)
  "Open the Shortcut STORY, given as an id, sc-id or [id]."
  (interactive (list (if (use-region-p)
                         (buffer-substring-no-properties (region-beginning) (region-end))
                       (read-string "Story: "))))
  (let ((story (◊--name story)))
    (setq story (string-remove-prefix "[" story))
    (setq story (string-remove-suffix "]" story))
    (setq story (string-remove-prefix "sc-" story))
    (browse-url (format "https://app.shortcut.com/findhotel/story/%s/" story))))

(defun ◊shortcut-epic (epic)
  "Open the Shortcut EPIC, given as an id, sc-id or [id]."
  (interactive (list (if (use-region-p)
                         (buffer-substring-no-properties (region-beginning) (region-end))
                       (read-string "Epic: "))))
  (let ((epic (◊--name epic)))
    (setq epic (string-remove-prefix "[" epic))
    (setq epic (string-remove-suffix "]" epic))
    (setq epic (string-remove-prefix "sc-" epic))
    (browse-url (format "https://app.shortcut.com/findhotel/epic/%s/" epic))))

(defun ◊duckduckgo (term)
  "Search DuckDuckGo for TERM."
  (interactive "sTerm: ")
  (browse-url (url-encode-url (format "https://duckduckgo.com?q=%s" term))))

(defun ◊google (term)
  "Search Google for TERM."
  (interactive "sTerm: ")
  (browse-url (url-encode-url (format "https://www.google.com/search?q=%s" term))))

(defun ◊--auth-headers (url)
  "Return HTTP headers for URL's host from its auth-source entry.
The entry's :headers field holds \"Name: value\" strings, either as
a list or as one string with a header per line.  Each value is
expanded with `s-format' against the entry's other fields, so
${secret} becomes the resolved secret."
  (when-let* ((host (url-host (url-generic-parse-url url)))
              (entry (car (auth-source-search :host host :max 1))))
    (mapcar (lambda (header)
              (unless (string-match "\\`\\([^:]+\\):[ \t]*\\(.*\\)\\'" header)
                (user-error "Malformed header %S for host %s" header host))
              (cons (match-string 1 header)
                    (s-format (match-string 2 header)
                              (lambda (key)
                                (let ((v (plist-get entry (intern (concat ":" key)))))
                                  (if (functionp v) (funcall v) v))))))
            (let ((headers (plist-get entry :headers)))
              (if (stringp headers) (split-string headers "\n" t "[ \t]+") headers)))))

(cl-defun ◊curl (url &rest rest &key (method 'get) headers name as then else
                     &allow-other-keys)
  "Request URL with `plz-see', adding auth headers for the host.
METHOD defaults to `get'.  Headers passed explicitly win over the
auth-source ones.  NAME names the response buffer, replacing any
buffer of that name; it then takes only AS `buffer', and THEN and
ELSE receive the renamed buffer."
  (let* ((full-url (if (and (string-prefix-p "/" url) plz-see-base-url)
                       (concat plz-see-base-url url)
                     url))
         (rest (cl-loop for (k v) on rest by #'cddr
                        unless (memq k '(:method :headers :name)) append (list k v))))
    (when name
      (unless (memq as '(nil buffer))
        (user-error "◊curl :name takes only :as buffer, not %S" as))
      (let ((rename (lambda (callback)
                      (lambda (buffer)
                        (when-let* ((old (get-buffer name))
                                    ((not (eq old buffer))))
                          (kill-buffer old))
                        (with-current-buffer buffer
                          (rename-buffer name))
                        (when callback (funcall callback buffer))))))
        (setq rest (append (list :as 'buffer
                                 :then (funcall rename then)
                                 :else (funcall rename (or else then)))
                           (cl-loop for (k v) on rest by #'cddr
                                    unless (memq k '(:as :then :else))
                                    append (list k v))))))
    (apply #'plz-see method url
           :headers (append headers (◊--auth-headers full-url))
           rest)))


;;;; Buffers

(defun ◊copy-buffer-name ()
  "Copy the current buffer name to the kill ring."
  (interactive)
  (kill-new (buffer-name))
  (message "added to kill-ring: %s" (buffer-name)))

(defun ◊ghostel-buffer (session-name)
  "Switch to the ghostel buffer running the SESSION-NAME session."
  (thread-last
    (buffer-list)
    (seq-filter (lambda (buf)
                  (and (with-current-buffer buf (derived-mode-p 'ghostel-mode))
                       (string-match-p (regexp-quote session-name) (buffer-name buf)))))
    car
    pop-to-buffer))


;;;; Documentation

;; `◊doc' is shortdoc for any feature: a browsable buffer in
;; `shortdoc-mode', sectioned by the `;;;' headings of the source file,
;; one entry per public symbol with its signature, a button to the full
;; description, and the first line of its doc-string.  From Lisp it
;; returns the same listing as plain text with full doc-strings, which
;; is what an agent reading through `emacsclient-eval' wants.

(defun ◊--doc-source-sections (file)
  "Return where each definition in FILE sits, as an alist.
Each element is (SYMBOL SECTION INDEX): SECTION is the heading above
the definition, or nil before the first one, and INDEX is the
definition's order in the file.  Headings are the shallowest level of
`;;;'-style comment the file uses for its own sections, so a file
sectioned with `;;;;' reads as well as one sectioned with `;;;'."
  (let (headings defs)
    (with-temp-buffer
      (insert-file-contents file)
      (goto-char (point-min))
      (while (re-search-forward
              (rx bol (or (seq (group (>= 3 ";")) " " (group (+ nonl)))
                          (seq "(" (? "cl-") "def" (* (any "a-z-")) (+ " ")
                               (? "(") (group (+ (not (any " ()\n")))))))
              nil t)
        (if (match-beginning 1)
            (let ((heading (string-trim (match-string 2))))
              (unless (or (member heading '("Code:" "Commentary:"))
                          (string-match-p " --- \\|ends here$" heading))
                (push (list (length (match-string 1)) heading (point)) headings)))
          (push (cons (intern (match-string 3)) (point)) defs))))
    (let* ((depth (and headings (apply #'min (mapcar #'car headings))))
           (sections (sort (seq-filter (lambda (h) (= (car h) depth)) headings)
                           (lambda (a b) (< (nth 2 a) (nth 2 b)))))
           (index 0))
      (mapcar (lambda (def)
                (let ((section nil))
                  (dolist (h sections)
                    (when (< (nth 2 h) (cdr def)) (setq section (nth 1 h))))
                  (list (car def) section (cl-incf index))))
              (nreverse defs)))))

(defun ◊--doc-file (sym kind)
  "Return the source file defining SYM as KIND, or nil."
  (when-let* ((file (symbol-file sym kind)))
    (let ((el (concat (file-name-sans-extension file) ".el")))
      (and (file-readable-p el) el))))

(defun ◊--doc-feature-file (feature)
  "Return the source file of FEATURE, or nil.
Found through `load-history' when FEATURE was loaded, and on the
`load-path' otherwise, so a feature evaluated from its buffer still
documents."
  (or (◊--doc-file feature 'provide)
      (ignore-errors (find-library-name (symbol-name feature)))))

(defconst ◊--doc-kind-order '(struct command function macro variable)
  "Kinds of definition in the order an unsectioned listing shows them.")

(defun ◊--doc-kinds (sym)
  "Return the kinds SYM is bound as, from `◊--doc-kind-order'."
  (delq nil (list (and (cl-find-class sym) 'struct)
                  (and (boundp sym) 'variable)
                  (and (fboundp sym)
                       (cond ((macrop sym) 'macro)
                             ((commandp sym) 'command)
                             (t 'function))))))

(defun ◊--doc-entry-before-p (a b)
  "Return non-nil when entry A lists before entry B in an unsectioned file.
Kinds follow `◊--doc-kind-order'; within a kind, names with fewer
words come first, and names with as many words sort alphabetically.
A word is a hyphen-separated part of the name."
  (let* ((rank (lambda (entry)
                 (or (seq-position ◊--doc-kind-order (car entry))
                     (length ◊--doc-kind-order))))
         (words (lambda (entry)
                  (length (split-string (symbol-name (cadr entry)) "-" t))))
         (ra (funcall rank a)) (rb (funcall rank b)))
    (cond ((/= ra rb) (< ra rb))
          ((/= (funcall words a) (funcall words b))
           (< (funcall words a) (funcall words b)))
          (t (string< (symbol-name (cadr a)) (symbol-name (cadr b)))))))

(defun ◊--doc-entries (feature)
  "Return FEATURE's public symbols grouped by source section.

The result is a list of (SECTION . ENTRIES) in reading order; each
entry is (KIND SYMBOL) with KIND from `◊--doc-kind-order'.  Within a
section entries keep source order; a file with no sections lists its
entries by kind instead, structs first and variables last.
Membership is what FEATURE's file defines, so it does not depend on
how symbols are named or how the file was loaded.  Public means the
name has no double-hyphen."
  (let* ((file (or (◊--doc-feature-file feature)
                   (user-error "No source file found for feature %s" feature)))
         (defs (◊--doc-source-sections file))
         ;; A file with no headings gets one unnamed group, not "Other".
         (sectioned (seq-some (lambda (def) (nth 1 def)) defs))
         groups seen)
    (dolist (def defs)
      (let ((sym (car def)))
        ;; A symbol defined more than once (a struct and its getter, a
        ;; variable and a function) lists all its kinds at its first
        ;; definition.
        (unless (or (string-match-p "--" (symbol-name sym)) (memq sym seen))
          (push sym seen)
          (dolist (kind (◊--doc-kinds sym))
            (let* ((section (or (nth 1 def) (and sectioned "Other")))
                   (group (assoc section groups))
                   (entry (list kind sym)))
              (if group
                  (setcdr group (append (cdr group) (list entry)))
                (push (cons section (list entry)) groups)))))))
    (unless sectioned
      (dolist (group groups)
        (setcdr group (sort (cdr group) #'◊--doc-entry-before-p))))
    (◊--doc-order-sections feature (nreverse groups))))

(defun ◊--doc-order-sections (feature groups)
  "Return GROUPS, an alist of (SECTION . ENTRIES), in reading order for FEATURE.
Sections named by FEATURE's `◊doc-sections' property come first in
that order, then the rest per `◊doc-section-order', then Other."
  (let* ((pinned (get feature '◊doc-sections))
         (other (assoc "Other" groups))
         (rest (seq-remove (lambda (g) (or (member (car g) pinned) (eq g other)))
                           groups)))
    (append (delq nil (mapcar (lambda (name) (assoc name groups)) pinned))
            (if (eq ◊doc-section-order 'reverse) (reverse rest) rest)
            (and other (list other)))))

(defun ◊--doc-first-line (doc)
  "Return the first line of DOC, or a note that there is none."
  (if (and doc (not (string-empty-p doc)))
      (car (split-string doc "\n"))
    "Not documented."))

(defun ◊--doc-function-doc (sym)
  "Return SYM's function doc-string without the trailing signature line."
  (let ((doc (or (ignore-errors (documentation sym)) "")))
    (string-trim (replace-regexp-in-string "^(fn\\_>.*\n?" "" doc))))

(defun ◊--doc-variable-doc (sym)
  "Return SYM's variable doc-string, or nil."
  (documentation-property sym 'variable-documentation))

(defun ◊--doc-struct-doc (sym)
  "Return SYM's struct doc-string, or nil."
  (when-let* ((class (cl-find-class sym)))
    (cl--class-docstring class)))

;;;;; Plain text

(defun ◊--doc-print-entry (kind sym)
  "Print the plain-text documentation of SYM as KIND for `princ'."
  (pcase kind
    ('struct
     (princ (format "Struct: %s (%s)\n%s\n\n" sym
                    (mapconcat #'symbol-name
                               (remq 'cl-tag-slot (mapcar #'car (cl-struct-slot-info sym)))
                               " ")
                    (or (◊--doc-struct-doc sym) "Not documented."))))
    ('variable
     (princ (format "Variable: %s\n%s\n\n" sym
                    (or (◊--doc-variable-doc sym) "Not documented."))))
    (_
     (let ((doc (◊--doc-function-doc sym)))
       (princ (format "%s: %s\n%s\n\n"
                      (pcase kind ('command "Command") ('macro "Macro") (_ "Function"))
                      (cons sym (help-function-arglist sym t))
                      (if (string-empty-p doc) "Not documented." doc)))))))

(defun ◊--doc-feature (feature)
  "Return FEATURE's public symbols as plain text, sectioned like its source."
  (with-output-to-string
    (dolist (group (◊--doc-entries feature))
      (when (car group)
        (princ (format "== %s ==\n\n" (car group))))
      (dolist (entry (cdr group))
        (◊--doc-print-entry (car entry) (cadr entry))))))

(defun ◊--doc-symbol-kinds (sym)
  "Return the kinds SYM can be documented as, or signal when none."
  (or (◊--doc-kinds sym)
      (user-error "%s is not a loadable feature, nor a function, variable, or struct type" sym)))

(defun ◊--doc-symbol (sym)
  "Return documentation for SYM alone as plain text."
  (with-output-to-string
    (dolist (kind (◊--doc-symbol-kinds sym))
      (◊--doc-print-entry kind sym))))

;;;;; Buffer

(defun ◊--doc-insert-entry (kind sym full)
  "Insert a shortdoc-style entry for SYM as KIND at point.
With FULL, the whole doc-string is shown instead of its first line."
  (let ((start (point))
        (describe (pcase kind
                    ('variable (lambda (_) (describe-variable sym)))
                    ('struct (lambda (_) (cl-describe-type sym)))
                    (_ (lambda (_) (describe-function sym)))))
        (doc (pcase kind
               ('variable (◊--doc-variable-doc sym))
               ('struct (◊--doc-struct-doc sym))
               (_ (◊--doc-function-doc sym)))))
    (when (memq kind '(function command macro)) (insert "("))
    (insert-text-button (symbol-name sym)
                        'face 'button
                        'action describe
                        'follow-link t
                        'help-echo "mouse-1, RET: describe")
    (add-text-properties start (1+ start) (list 'shortdoc-function sym 'outline-level 2))
    (pcase kind
      ((or 'function 'command 'macro)
       (dolist (arg (help-function-arglist sym t))
         (insert " " (symbol-name arg)))
       (insert ")" (pcase kind ('command "  command") ('macro "  macro") (_ ""))))
      ('struct
       (insert " (" (mapconcat #'symbol-name
                               (remq 'cl-tag-slot (mapcar #'car (cl-struct-slot-info sym)))
                               " ")
               ")  struct"))
      (_ (insert "  " (if (custom-variable-p sym) "option" "variable"))))
    (insert "\n  "
            (if full
                (string-replace "\n" "\n  " (substitute-command-keys (or doc "Not documented.")))
              (◊--doc-first-line doc))
            "\n")
    (add-face-text-property start (point) 'shortdoc-section t)))

(defun ◊--doc-insert-section (title)
  "Insert a shortdoc-style section heading TITLE at point."
  (unless (bobp) (insert "\n"))
  (insert (propertize title 'face 'shortdoc-heading 'shortdoc-section t 'outline-level 1)
          (propertize "\n\n" 'face 'shortdoc-heading 'shortdoc-section t)))

(defun ◊--doc-display (thing feature-p)
  "Show THING's documentation in a *doc-THING* buffer.
FEATURE-P says whether THING is a feature or one symbol."
  (let ((buffer (get-buffer-create (format "*doc-%s*" thing))))
    (with-current-buffer buffer
      (let ((inhibit-read-only t))
        (erase-buffer)
        (shortdoc-mode)
        (button-mode)
        (if feature-p
            (dolist (group (◊--doc-entries thing))
              (when (car group)
                (◊--doc-insert-section (car group)))
              (let (prev)
                (dolist (entry (cdr group))
                  (when prev
                    (insert (make-separator-line)
                            (propertize "\n" 'face '(:height 0))))
                  (setq prev t)
                  (◊--doc-insert-entry (car entry) (cadr entry) nil))))
          (dolist (kind (◊--doc-symbol-kinds thing))
            (◊--doc-insert-entry kind thing t)
            (insert "\n"))))
      (goto-char (point-min)))
    (pop-to-buffer buffer)))

(defun ◊doc (thing)
  "Return documentation for THING.
When THING is a loadable feature (something `require' can find), this
returns its public functions, variables, and struct types, sectioned
by the `;;;' headings of the file that defines them - see
`◊--doc-feature'.  Otherwise THING must already be a bound function,
variable, or `cl-defstruct' type, and its own documentation is
returned alone - see `◊--doc-symbol'.

Output is plain text: signature or variable/struct name, then its
doc-string.

Interactively, prompt for THING, offering the symbol at point, and
browse it shortdoc-style in a *doc-THING* buffer: one entry per
symbol with a button to its full description, `n' and `p' between
entries, `N' and `P' between sections."
  (interactive
   (list (intern (completing-read
                  "Documentation for: " obarray
                  (lambda (sym)
                    (or (fboundp sym) (boundp sym) (featurep sym)
                        (cl-find-class sym)))
                  nil nil nil (thing-at-point 'symbol t)))))
  (let* ((feature-p (condition-case nil (require thing) (file-missing nil)))
         (doc (if feature-p (◊--doc-feature thing) (◊--doc-symbol thing))))
    (when (called-interactively-p 'any)
      (◊--doc-display thing feature-p))
    doc))


;;;; Entry point

(declare-function cape-elisp-symbol "cape")

;;;###autoload
(defun ◊insert-sexp ()
  "Insert ◊ sexp and complete the command that follows it."
  (interactive)
  (insert "(◊)")
  (left-char)
  (call-interactively #'cape-elisp-symbol))

(defun ◊insert-lozenge ()
  "Insert ◊ symbol."
  (interactive)
  (insert "◊"))

(defcustom ◊eval-look-back-lines 50
  "How many lines above point ◊eval scans for the start of a sexp."
  :type 'integer
  :group 'lozenge)

(defun ◊--read-end (start)
  "Return the end of the sexp the Lisp reader sees at START, nil when none.

The reader decides, so the answer does not depend on the major
mode's idea of what a paren or a string is."
  (let ((text (buffer-substring-no-properties start (point-max))))
    (condition-case nil
        (+ start (cdr (read-from-string text)))
      (error nil))))

(defun ◊--sexp-bounds ()
  "Return the bounds of the sexp at point, nil when there is none.

The outermost sexp enclosing point wins; failing that, the first
one starting on the current line, so point may also sit before or
after the sexp it means."
  (save-excursion
    (let* ((pt (point))
           (bol (line-beginning-position))
           (limit (save-excursion
                    (let ((floor (line-beginning-position
                                  (- 1 ◊eval-look-back-lines))))
                      (if (re-search-backward "^[ \t]*$" floor t)
                          (point)
                        floor))))
           (starts nil))
      (goto-char (line-end-position))
      (while (search-backward "(" limit t)
        (push (point) starts))
      (or (seq-some (lambda (start)
                      (let ((end (and (<= start pt) (◊--read-end start))))
                        (and end (<= pt end) (cons start end))))
                    starts)
          (seq-some (lambda (start)
                      (let ((end (and (>= start bol) (◊--read-end start))))
                        (and end (cons start end))))
                    starts)))))

(defun ◊--sexp-bounds-or-error ()
  "Return the bounds of the sexp at point, signalling when there is none."
  (or (◊--sexp-bounds)
      (if (string-search "(" (buffer-substring-no-properties
                              (line-beginning-position)
                              (line-end-position)))
          (user-error "Sexp at point does not read - unbalanced?")
        (user-error "No sexp at point"))))

(defun ◊--eval-bounds (bounds)
  "Evaluate the sexp between the BOUNDS cons and return its value."
  (eval (car (read-from-string
              (buffer-substring-no-properties (car bounds) (cdr bounds))))
        t))

;;;###autoload
(defun ◊eval (&optional replace)
  "Evaluate the outermost sexp around point and echo its value.
With REPLACE (\\[universal-argument]), replace the sexp with its value instead,
as `◊eval-and-replace' does.

Works in any major mode, so a sexp written in a note runs where it
is written."
  (interactive "P")
  (if replace
      (◊eval-and-replace)
    (message "%S" (◊--eval-bounds (◊--sexp-bounds-or-error)))))

;;;###autoload
(defun ◊eval-and-replace ()
  "Evaluate the outermost sexp around point and replace it with its value.

A string value goes in as its text, any other value as Lisp would
print it.  A sexp run for its effect gives no output - nil, or an
object that does not print readably, like the process `browse-url'
starts - so it stays, as it does when evaluation fails."
  (interactive)
  (let* ((bounds (◊--sexp-bounds-or-error))
         (value (◊--eval-bounds bounds))
         (text (if (stringp value) value (prin1-to-string value))))
    (if (or (null value) (string-prefix-p "#<" text))
        (message "%s" text)
      (goto-char (car bounds))
      (delete-region (car bounds) (cdr bounds))
      (insert text))))


;;;; Aliases

(defalias '◊ff '◊find-file)
(defalias '◊git-commit '◊show-commit)

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