Use different modes for spec list, specs, and examples

xiongtx · bbatsov · commit d000c62bf070 · 2017-07-19T07:53:22.000+03:00
Fixes #2035 and fixes #2036. - `cider-browse-spec` now has its own major mode, `cider-browse-spec-view-mode`, which derives from `help-mode` and has forward/back xrefs. - `cider-browse-spec--print-curr-spec-example` now puts examples in a buffer with `cider-browse-spec-example-mode`. This allows using `revert-buffer` to generate new examples. - The `cider-browse-spec-navigation` stack variable and related functionality are removed. - `cider-browse-spec-view-mode` now derives from `help-mode`, which maintains its own stack variables. Future improvements: - Allow using `TAB` and `<backtab>` in `cider-browse-spec-view-mode` to invoke `cider-browse-spec--next-spec` and `cider-browse-spec--prev-spec` respectively.
diff --git a/cider-browse-spec.el b/cider-browse-spec.el
@@ -25,7 +25,7 @@
 ;;
 ;; Display a spec description you can browse.
 ;; Pressing <enter> over a sub spec will take you to the description of that sub spec.
-;; Pressing ^ will take you up in the navigation stack.
+;; Pressing ^ takes you to the list of all specs.
 
 ;; M-x cider-browse-spec-all
 ;;
@@ -47,12 +47,6 @@
 (defconst cider-browse-spec-buffer "*cider-spec-browser*")
 (add-to-list 'cider-ancillary-buffers cider-browse-spec-buffer)
 
-(defvar cider-browse-spec-navigation '()
-  "Keeps the cider spec browser navigation stack.
-A list of strings which are specs or specs searches.
-First of the list is the top of the stack.
-Specs searches are encoded as (search \"regex\")
-For example: (\":ring.request/header-name\" \":ring.request/headers\" \":ring/request\" (search \"ring.+\"))")
 (defconst cider-browse-spec-example-buffer "*cider-spec-example*")
 (add-to-list 'cider-ancillary-buffers cider-browse-spec-example-buffer)
 
@@ -62,11 +56,10 @@ For example: (\":ring.request/header-name\" \":ring.request/headers\" \":ring/re
   (let ((map (make-sparse-keymap)))
     (set-keymap-parent map cider-popup-buffer-mode-map)
     (define-key map (kbd "RET") #'cider-browse-spec--browse-at-point)
-    (define-key map "^" #'cider-browse-spec--navigate-back)
     (define-key map "n" #'cider-browse-spec--next-spec)
     (define-key map "p" #'cider-browse-spec--prev-spec)
-    (define-key map "e" #'cider-browse-spec--print-curr-spec-example)
-    map))
+    map)
+  "Keymap for `cider-browse-spec-mode'.")
 
 (defvar cider-browse-spec-mouse-map
   (let ((map (make-sparse-keymap)))
@@ -81,11 +74,47 @@ For example: (\":ring.request/header-name\" \":ring.request/headers\" \":ring/re
   (when cider-special-mode-truncate-lines
     (setq-local truncate-lines t)))
 
-;; Non interactive functions
+(defvar cider-browse-spec--current-spec nil)
+
+(defvar cider-browse-spec-view-mode-map
+  (let ((map (make-sparse-keymap)))
+    (set-keymap-parent map help-mode-map)
+    (define-key map (kbd "RET") #'cider-browse-spec--browse-at-point)
+    (define-key map "^" #'cider-browse-spec-all)
+    (define-key map "e" #'cider-browse-spec--print-curr-spec-example)
+    (define-key map "n" #'cider-browse-spec--next-spec)
+    (define-key map "p" #'cider-browse-spec--prev-spec)
+    map)
+  "Keymap for `cider-browse-spec-view-mode'.")
 
-(defun cider-browse-spec--clear-nav-history ()
-  "Clears `cider-browse-spec-navigation'."
-  (setq cider-browse-spec-navigation '()))
+(define-derived-mode cider-browse-spec-view-mode help-mode "Spec view"
+  "Major mode for displaying CIDER spec.
+
+\\{cider-browse-spec-view-mode-map}"
+  (setq-local cider-browse-spec--current-spec nil)
+  (setq-local electric-indent-chars nil)
+  (when cider-special-mode-truncate-lines
+    (setq-local truncate-lines t)))
+
+(defvar cider-browse-spec-example-mode-map
+  (let ((map (make-sparse-keymap)))
+    (set-keymap-parent map cider-popup-buffer-mode-map)
+    (define-key map "^" #'cider-browse-spec-all)
+    (define-key map "e" #'cider-browse-spec--print-curr-spec-example)
+    (define-key map "g" #'revert-buffer)
+    map)
+  "Keymap for `cider-browse-spec-example-mode'.")
+
+(define-derived-mode cider-browse-spec-example-mode special-mode "Example"
+  "Major mode for Clojure spec examples.
+
+\\{cider-browse-spec-example-mode-map}"
+  (setq-local electric-indent-chars nil)
+  (setq-local revert-buffer-function #'cider-browse-spec--example-revert-buffer-function)
+  (when cider-special-mode-truncate-lines
+    (setq-local truncate-lines t)))
+
+;; Non interactive functions
 
 (defun cider-browse-spec--propertize-keyword (kw)
   "Add properties to KW text needed by the spec browser."
@@ -220,8 +249,8 @@ Display TITLE at the top and SPECS are indented underneath."
                (format "(s/fspec \n %s)")))
             ;; every other with no special management
             (t (format "(%s %s)"
-                        (cider-browse-spec--pprint form-tag)
-                        (string-join (mapcar #'cider-browse-spec--pprint (cl-rest form)) " "))))))
+                       (cider-browse-spec--pprint form-tag)
+                       (string-join (mapcar #'cider-browse-spec--pprint (cl-rest form)) " "))))))
         (t (format "%s" form))))
 
 (defun cider-browse-spec--draw-spec-buffer (buffer spec spec-form)
@@ -230,8 +259,7 @@ Display SPEC as a title and uses `cider-browse-spec--pprint' to display
 a more user friendly representation of SPEC-FORM."
   (with-current-buffer buffer
     (let ((inhibit-read-only t))
-      (cider-browse-spec-mode)
-      (erase-buffer)
+      (cider--help-setup-xref (list #'cider-browse-spec spec) nil buffer)
       (goto-char (point-max))
       (insert (cider-font-lock-as-clojure spec) "\n\n")
       (insert (with-temp-buffer
@@ -240,25 +268,21 @@ a more user friendly representation of SPEC-FORM."
                 (indent-region (point-min) (point-max))
                 (font-lock-ensure)
                 (buffer-string)))
-      (insert "\n\n")
-      (insert-text-button "[Back]"
-                          'action (lambda (b) (call-interactively 'cider-browse-spec--navigate-back))
-                          'follow-link t)
-      (goto-char (point-min)))))
+      (cider--make-back-forward-xrefs)
+      (current-buffer))))
 
 (defun cider-browse-spec--browse (spec)
-  "Browse SPEC pushing it into `cider-browse-spec-navigation'."
+  "Browse SPEC."
+  (cider-ensure-connected)
+  (cider-ensure-op-supported "spec-form")
   (with-current-buffer (cider-popup-buffer cider-browse-spec-buffer t)
-    (push spec cider-browse-spec-navigation)
+    (cider-browse-spec-view-mode)
+    (setq-local cider-browse-spec--current-spec spec)
     (cider-browse-spec--draw-spec-buffer (current-buffer)
-                             spec
-                             (cider-sync-request:spec-form spec))))
-
-(defun cider-browse-spec--is-nav-searchp (str-filter)
-  "Return non nil if STR-FILTER is a filter term."
-  (and (listp str-filter)
-       (eq (car str-filter) 'search)))
-
+                                         spec
+                                         (cider-sync-request:spec-form spec))
+    (goto-char (point-min))
+    (current-buffer)))
 
 ;; Interactive Functions
 
@@ -267,7 +291,7 @@ a more user friendly representation of SPEC-FORM."
   (interactive)
   (goto-char (next-single-property-change (point) 'spec-name))
   (unless (get-text-property (point) 'spec-name)
-      (goto-char (next-single-property-change (point) 'spec-name))))
+    (goto-char (next-single-property-change (point) 'spec-name))))
 
 (defun cider-browse-spec--prev-spec ()
   "Move to the previous spec in the buffer."
@@ -277,66 +301,62 @@ a more user friendly representation of SPEC-FORM."
     (goto-char (previous-single-property-change (point) 'spec-name))))
 
 (defun cider-browse-spec--print-curr-spec-example ()
-  "Generate and print a spec example of the current spec in `cider-browse-spec-navigation'."
+  "Generate and print an example of the current spec."
   (interactive)
-  (when cider-browse-spec-navigation
-    (let* ((spec (cl-first cider-browse-spec-navigation))
-           (example (cider-sync-request:spec-example spec)))
-      (with-current-buffer (cider-popup-buffer cider-browse-spec-example-buffer t)
-        (cider-browse-spec-mode)
-        (let ((inhibit-read-only t))
-          (erase-buffer)
-          (goto-char (point-max))
-          (insert (cider-propertize (concat "Example of: " spec) 'emph) "\n\n")
-          (insert example)
-          (goto-char (point-min)))))))
+  (cider-ensure-connected)
+  (cider-ensure-op-supported "spec-example")
+  (if-let ((spec cider-browse-spec--current-spec))
+      (if-let ((example (cider-sync-request:spec-example spec)))
+          (with-current-buffer (cider-popup-buffer cider-browse-spec-example-buffer t)
+            (cider-browse-spec-example-mode)
+            (setq-local cider-browse-spec--current-spec spec)
+            (let ((inhibit-read-only t))
+              (insert "Example of " (cider-font-lock-as-clojure spec))
+              (insert "\n\n")
+              (insert (cider-font-lock-as-clojure example))
+              (goto-char (point-min))))
+        (error (format "No example for spec %s" spec)))
+    (error "No current spec")))
+
+(defun cider-browse-spec--example-revert-buffer-function (&rest _)
+  "`revert-buffer' function for `cider-browse-spec-example-mode'.
+
+Generates a new example for the current spec."
+  (cider-browse-spec--print-curr-spec-example))
 
 ;;;###autoload
 (defun cider-browse-spec (spec)
-  "Start a new navigation and browse to SPEC definition."
+  "Browse SPEC definition."
   (interactive (list (completing-read "Browse spec: "
                                       (cider-sync-request:spec-list)
                                       nil nil
                                       (cider-symbol-at-point))))
-  (cider-browse-spec--clear-nav-history)
   (cider-browse-spec--browse spec))
 
-
 ;;;###autoload
-(defun cider-browse-spec-all (&optional filter-regex)
-  "List all loaded specs in BUFFER filtered by FILTER-REGEX.
-
-Optional argument FILTER-REGEX is a regexp string matching spec names.  The
-default value, \"\", matches all specs in the registry."
-  (interactive (list (read-string "Filter regex: ")))
-  (with-current-buffer (cider-popup-buffer cider-browse-spec-buffer t)
-    (let ((specs (cider-sync-request:spec-list filter-regex)))
-      (cider-browse-spec--clear-nav-history)
-      (push `(search ,filter-regex) cider-browse-spec-navigation)
-      (cider-browse-spec--draw-list-buffer (current-buffer)
-                                           (if (string-empty-p filter-regex)
-                                   "All specs in registry"
-                                 (format "All specs matching regex `%s' in registry" filter-regex))
-                               specs))))
+(defun cider-browse-spec-all (&optional arg)
+  "Open list of specs in a popup buffer.
+
+With a prefix argument ARG, prompts for a regexp to filter specs.
+No filter applied if the regexp is the empty string."
+  (interactive "P")
+  (cider-ensure-connected)
+  (cider-ensure-op-supported "spec-list")
+  (let ((filter-regex (if arg (read-string "Filter regex: ") "")))
+    (with-current-buffer (cider-popup-buffer cider-browse-spec-buffer t)
+      (let ((specs (cider-sync-request:spec-list filter-regex)))
+        (cider-browse-spec--draw-list-buffer (current-buffer)
+                                             (if (string-empty-p filter-regex)
+                                                 "All specs in registry"
+                                               (format "All specs matching regex `%s' in registry" filter-regex))
+                                             specs)))))
 
 (defun cider-browse-spec--browse-at-point ()
   "Go to the definition of the spec at point inside `cider-browse-spec-buffer'."
   (interactive)
   (when-let ((spec (get-text-property (point) 'spec-name)))
     (cider-browse-spec--browse spec)))
 
-(defun cider-browse-spec--navigate-back ()
-  "Move the browser back in `cider-browse-spec-navigation'."
-  (interactive)
-  (if (> (length cider-browse-spec-navigation) 1)
-      (progn
-       (pop cider-browse-spec-navigation) ;; discard current
-       (if (cider-browse-spec--is-nav-searchp (cl-first cider-browse-spec-navigation))
-           (cider-browse-spec-all (cl-second (pop cider-browse-spec-navigation)))
-         (cider-browse-spec--browse (pop cider-browse-spec-navigation))))
-    (unless (cider-browse-spec--is-nav-searchp (cl-first cider-browse-spec-navigation))
-      (cider-browse-spec-all))))
-
 (defun cider-browse-spec-handle-mouse (event)
   "Handle mouse click EVENT."
   (interactive "e")
