dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

cider-clojuredocs.el (6399B)


      1 ;;; cider-clojuredocs.el --- ClojureDocs integration -*- lexical-binding: t -*-
      2 
      3 ;; Copyright © 2014-2023 Bozhidar Batsov and CIDER contributors
      4 ;;
      5 ;; Author: Bozhidar Batsov <bozhidar@batsov.dev>
      6 
      7 ;; This program is free software: you can redistribute it and/or modify
      8 ;; it under the terms of the GNU General Public License as published by
      9 ;; the Free Software Foundation, either version 3 of the License, or
     10 ;; (at your option) any later version.
     11 
     12 ;; This program is distributed in the hope that it will be useful,
     13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     15 ;; GNU General Public License for more details.
     16 
     17 ;; You should have received a copy of the GNU General Public License
     18 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
     19 
     20 ;; This file is not part of GNU Emacs.
     21 
     22 ;;; Commentary:
     23 
     24 ;; A few commands for ClojureDocs documentation lookup.
     25 
     26 ;;; Code:
     27 
     28 (require 'cider-client)
     29 (require 'cider-common)
     30 (require 'subr-x)
     31 (require 'cider-popup)
     32 
     33 (require 'nrepl-dict)
     34 
     35 (require 'url-vars)
     36 
     37 (defconst cider-clojuredocs-url "https://clojuredocs.org/")
     38 
     39 (defconst cider-clojuredocs-buffer "*cider-clojuredocs*")
     40 
     41 (defun cider-sync-request:clojuredocs-lookup (ns sym)
     42   "Perform nREPL \"resource\" op with NS and SYM."
     43   (thread-first `("op" "clojuredocs-lookup"
     44                   "ns" ,ns
     45                   "sym" ,sym)
     46                 (cider-nrepl-send-sync-request)
     47                 (nrepl-dict-get "clojuredocs")))
     48 
     49 (defun cider-sync-request:clojuredocs-refresh ()
     50   "Refresh the ClojureDocs cache."
     51   (thread-first '("op" "clojuredocs-refresh-cache")
     52                 (cider-nrepl-send-sync-request)
     53                 (nrepl-dict-get "status")))
     54 
     55 (defun cider-clojuredocs-replace-special (name)
     56   "Convert the dashes in NAME to a ClojureDocs friendly format.
     57 We need to handle \"?\", \".\", \"..\" and \"/\"."
     58   (thread-last
     59     name
     60     (replace-regexp-in-string "\\?" "_q")
     61     (replace-regexp-in-string "\\(\\.+\\)" "_\\1")
     62     (replace-regexp-in-string "/" "fs")))
     63 
     64 (defun cider-clojuredocs-url (name ns)
     65   "Generate a ClojureDocs url from NAME and NS."
     66   (let ((base-url cider-clojuredocs-url))
     67     (when (and name ns)
     68       (concat base-url ns "/" (cider-clojuredocs-replace-special name)))))
     69 
     70 (defun cider-clojuredocs-web-lookup (sym)
     71   "Open the ClojureDocs documentation for SYM in a web browser."
     72   (if-let* ((var-info (cider-var-info sym)))
     73       (let ((name (nrepl-dict-get var-info "name"))
     74             (ns (nrepl-dict-get var-info "ns")))
     75         (browse-url (cider-clojuredocs-url name ns)))
     76     (error "Symbol %s not resolved" sym)))
     77 
     78 ;;;###autoload
     79 (defun cider-clojuredocs-web (&optional arg)
     80   "Open ClojureDocs documentation in the default web browser.
     81 
     82 Prompts for the symbol to use, or uses the symbol at point, depending on
     83 the value of `cider-prompt-for-symbol'.  With prefix arg ARG, does the
     84 opposite of what that option dictates."
     85   (interactive "P")
     86   (funcall (cider-prompt-for-symbol-function arg)
     87            "ClojureDocs doc for"
     88            #'cider-clojuredocs-web-lookup))
     89 
     90 ;;;###autoload
     91 (defun cider-clojuredocs-refresh-cache ()
     92   "Refresh the ClojureDocs cache."
     93   (interactive)
     94   (let ((result (cider-sync-request:clojuredocs-refresh)))
     95     (if (member "ok" result)
     96         (message "ClojureDocs cache refreshed successfully")
     97       (message "An error occurred while trying to refresh the ClojureDocs cache"))))
     98 
     99 (defun cider-create-clojuredocs-buffer (content)
    100   "Create a new ClojureDocs buffer with CONTENT."
    101   (with-current-buffer (cider-popup-buffer cider-clojuredocs-buffer t)
    102     (read-only-mode -1)
    103     (set-syntax-table clojure-mode-syntax-table)
    104     (local-set-key (kbd "C-c C-d C-c") 'cider-clojuredocs)
    105     (insert content)
    106     (cider-popup-buffer-mode 1)
    107     (view-mode 1)
    108     (goto-char (point-min))
    109     (current-buffer)))
    110 
    111 (defun cider-clojuredocs--content (dict)
    112   "Generate a nice string from DICT."
    113   (with-temp-buffer
    114     (insert "= " (nrepl-dict-get dict "ns") "/" (nrepl-dict-get dict "name") "\n\n")
    115     (let ((arglists (nrepl-dict-get dict "arglists")))
    116       (dolist (arglist arglists)
    117         (insert (format " [%s]\n" arglist)))
    118       (insert "\n")
    119       (insert (nrepl-dict-get dict "doc"))
    120       (insert "\n"))
    121     (insert "\n== See Also\n\n")
    122     (if-let ((see-alsos (nrepl-dict-get dict "see-alsos")))
    123         (dolist (see-also see-alsos)
    124           (insert-text-button (format "* %s\n" see-also)
    125                               'sym see-also
    126                               'action (lambda (btn)
    127                                         (cider-clojuredocs-lookup (button-get btn 'sym)))
    128                               'help-echo (format "Press Enter or middle click to jump to %s" see-also)))
    129       (insert "Not available\n"))
    130     (insert "\n== Examples\n\n")
    131     (if-let ((examples (nrepl-dict-get dict "examples")))
    132         (dolist (example examples)
    133           (insert (cider-font-lock-as-clojure example))
    134           (insert "\n-------------------------------------------------\n"))
    135       (insert "Not available\n"))
    136     (insert "\n== Notes\n\n")
    137     (if-let ((notes (nrepl-dict-get dict "notes")))
    138         (dolist (note notes)
    139           (insert note)
    140           (insert "\n-------------------------------------------------\n"))
    141       (insert "Not available\n"))
    142     (buffer-string)))
    143 
    144 (defun cider-clojuredocs-lookup (sym)
    145   "Look up the ClojureDocs documentation for SYM."
    146   (let ((docs (cider-sync-request:clojuredocs-lookup (cider-current-ns) sym)))
    147     (pop-to-buffer (cider-create-clojuredocs-buffer (cider-clojuredocs--content docs)))
    148     ;; highlight the symbol in question in the docs buffer
    149     (highlight-regexp
    150      (regexp-quote
    151       (or (cadr (split-string sym "/"))
    152           sym))
    153      'bold)))
    154 
    155 ;;;###autoload
    156 (defun cider-clojuredocs (&optional arg)
    157   "Open ClojureDocs documentation in a popup buffer.
    158 
    159 Prompts for the symbol to use, or uses the symbol at point, depending on
    160 the value of `cider-prompt-for-symbol'.  With prefix arg ARG, does the
    161 opposite of what that option dictates."
    162   (interactive "P")
    163   (when (derived-mode-p 'clojurescript-mode)
    164     (user-error "`cider-clojuredocs' doesn't support ClojureScript"))
    165   (funcall (cider-prompt-for-symbol-function arg)
    166            "ClojureDocs doc for"
    167            #'cider-clojuredocs-lookup))
    168 
    169 (provide 'cider-clojuredocs)
    170 
    171 ;;; cider-clojuredocs.el ends here