diff --git a/emacs/flan-dev.el b/emacs/flan-dev.el index 4c26f56..75b3723 100644 --- a/emacs/flan-dev.el +++ b/emacs/flan-dev.el @@ -873,6 +873,93 @@ Nothing is offered when nothing is known — an empty table would look like ;; indenting it is ASCII, so the two agree here. (max 0 (1- (nth 2 parts))))))))))))) +;;; Documentation + +;; What the daemon already knows about a name, in a buffer rather than in the +;; echo area. eldoc gives you the signature of the thing you are typing, which +;; is the right answer while typing and the wrong one when the question is +;; "what is this?" — a signature that has scrolled past, a kind you are not +;; sure of, and a location you want to look at rather than jump to. +;; +;; Nothing here asks the program anything new: `defs' carries all four facts +;; already. It is refreshed first when there is a connection, because the +;; cache is otherwise as old as the last install and a doc buffer is exactly +;; where a stale signature would be believed. + +(defvar flan-doc-buffer "*flan-doc*" + "Buffer `flan-doc' writes into.") + +(define-derived-mode flan-doc-mode special-mode "Flan-Doc" + "Mode for the buffer `flan-doc' writes.") + +(defun flan-doc--goto (loc) + "Visit LOC, a \"file:line:col\" the daemon gave for a definition." + (let ((parts (flan-dev--parse-loc loc))) + (unless parts (user-error "flan: unreadable location: %s" loc)) + (find-file-other-window (nth 0 parts)) + (goto-char (flan-dev--position (nth 1 parts) (nth 2 parts))))) + +(defun flan-doc--where (d) + "Insert where D is defined, or why that cannot be said." + (let* ((loc (nth 3 d)) + (parts (and (not (equal loc "")) (flan-dev--parse-loc loc)))) + (cond + ;; Said, not omitted. A missing line reads as "it has no home"; the + ;; truth is that Tast.global and Tast.extern carry no Loc, which is a + ;; fact about the compiler and worth saying in the same words M-. uses. + ((equal loc "") + (insert (format "Defined the daemon reports no location for a %s\n" + (nth 1 d)))) + ((null parts) (insert (format "Defined at %s, which is unreadable\n" loc))) + ((or (string-match-p "\\`<.*>\\'" (nth 0 parts)) + (not (file-exists-p (nth 0 parts)))) + (insert (format "Defined in %s, which is not a file on disk\n" + (nth 0 parts)))) + (t + (insert "Defined ") + (insert-button (format "%s:%d" (nth 0 parts) (nth 1 parts)) + 'action (lambda (_) (flan-doc--goto loc)) + 'follow-link t + 'help-echo "Visit this definition") + (insert "\n"))))) + +;;;###autoload +(defun flan-doc (name) + "Show what the running program knows about NAME. +Interactively, the name at point, or one read with completion when point is +not on one. Refuses a bare name that could be several packaged ones, in the +same words `M-.' does: picking one would be a guess about which you meant." + (interactive + (list (or (thing-at-point 'symbol t) + (completing-read "Describe name: " (mapcar #'car flan-dev--defs) + nil t)))) + (unless flan-dev--defs + (user-error "flan: nothing is known about any name; connect first (C-c C-z)")) + (when (process-live-p flan-dev--connection) + (ignore-errors (flan-dev-refresh-defs))) + (let ((d (flan-dev--lookup name))) + (unless d + (if-let ((hits (flan-dev--ambiguous name))) + (user-error "flan: %s could be %s; write the one you mean" + name (string-join (mapcar #'car hits) " or ")) + (user-error "flan: the running program defines no %s" name))) + (with-current-buffer (get-buffer-create flan-doc-buffer) + (let ((inhibit-read-only t)) + (erase-buffer) + (flan-doc-mode) + (insert (propertize (nth 0 d) 'face 'font-lock-function-name-face) "\n\n") + (insert (propertize (nth 2 d) 'face 'font-lock-type-face) "\n\n") + (insert (format "Kind %s\n" (nth 1 d))) + (flan-doc--where d) + ;; Parameter names are not in the Tast — the checker keeps types — + ;; so a signature is types only, and someone reading this buffer + ;; should be told that rather than left to wonder. + (when (member (nth 1 d) '("fn" "extern")) + (insert "\nParameter names are not kept past the checker, so a\n" + "signature shows types only.\n")) + (goto-char (point-min)))) + (display-buffer flan-doc-buffer))) + ;;; Wiring it into a buffer (defun flan-dev-setup () diff --git a/emacs/flan-mode.el b/emacs/flan-mode.el index 077fe32..4b04f60 100644 --- a/emacs/flan-mode.el +++ b/emacs/flan-mode.el @@ -8,6 +8,9 @@ ;;; Code: (require 'lisp-mode) +;; For `imenu-generic-expression', which is set below and which would +;; otherwise be made buffer-local before its own defvar had run. +(require 'imenu) ;; The keymap binds them; loading the client is what defines them, and a user ;; may well edit Flan without ever connecting to a running program. @@ -19,6 +22,9 @@ (declare-function flan-describe "flan-dev") (declare-function flan-show-output "flan-dev") (declare-function flan-repl "flan-repl") +(declare-function flan-doc "flan-dev") +(declare-function flan-dev "flan-dev") +(declare-function flan-dev-quit "flan-dev") (defgroup flan nil "Editing and evaluating Flan." @@ -52,6 +58,38 @@ . font-lock-constant-face)) "Font lock for `flan-mode'.") +(defconst flan--name-re "\\(\\(?:\\sw\\|\\s_\\)+\\)" + "A Flan name, as one group. +Written in terms of the syntax table rather than as a character class, so +that the characters a name may contain are stated in one place — the table +below — and not again here.") + +;; Anchored at the start of a line, which is where a top-level form is: a +;; `defn' nested inside a `let' is not a definition of anything, and a match +;; that ignored the column would offer one. +(defvar flan-imenu-generic-expression + `(("Functions" ,(concat "^(defn\\s-+" flan--name-re) 1) + ("Types" ,(concat "^(def\\(?:struct\\|union\\|enum\\|alias\\)\\s-+" + flan--name-re) + 1) + ("Variables" ,(concat "^(def\\(?:var\\|const\\)\\s-+" flan--name-re) 1) + ;; A forward declaration is not a definition, and a file with both would + ;; otherwise show the same name twice with nothing to tell them apart. + ("Declared" ,(concat "^(declare\\s-+" flan--name-re) 1)) + "Imenu index for `flan-mode', by what each form introduces.") + +(defun flan-current-defun-name () + "The name of the top-level definition point is in, or nil. +For `which-func-functions': a long file scrolled into the middle of a +function is the case this exists for, and it is the case where the header +line is off screen." + (save-excursion + (ignore-errors + (beginning-of-defun) + (and (looking-at (concat "(" (regexp-opt flan--definers t) "\\_>\\s-+" + flan--name-re)) + (match-string-no-properties 2))))) + (defvar flan-mode-syntax-table (let ((table (make-syntax-table lisp-mode-syntax-table))) ;; Flan's own punctuation in names: a name may contain - ? > / and . @@ -81,6 +119,10 @@ (define-key map (kbd "C-c C-o") #'flan-show-output) (define-key map (kbd "C-c C-r") #'flan-repl) (define-key map (kbd "C-c C-b") #'flan-break) + ;; Help on the name at point. C-c C-d is taken by `flan-describe', which + ;; is about the session rather than about a name, and renaming a key that + ;; is already documented costs more than it is worth. + (define-key map (kbd "C-c C-h") #'flan-doc) map) "Keymap for `flan-mode'.") @@ -96,7 +138,10 @@ (setq-local font-lock-defaults '(flan-font-lock-keywords)) (setq-local indent-line-function #'lisp-indent-line) (setq-local lisp-indent-function #'flan-indent-function) - (setq-local outline-regexp ";;;;+[ \t]*")) + (setq-local outline-regexp ";;;;+[ \t]*") + (setq-local imenu-generic-expression flan-imenu-generic-expression) + ;; Buffer-locally, because this answers for Flan and nothing else. + (add-hook 'which-func-functions #'flan-current-defun-name nil t)) (defun flan-indent-function (indent-point state) "Indent like Lisp, with Flan's body forms as special forms. diff --git a/emacs/test-flan-dev.el b/emacs/test-flan-dev.el index d936ee0..6639d7f 100644 --- a/emacs/test-flan-dev.el +++ b/emacs/test-flan-dev.el @@ -463,6 +463,44 @@ is written instead — the real `message' call the real command makes." (and said (string-match-p "2" said)))) (delete-region beg (point-max))) + ;; ── The documentation buffer ────────────────────────────────────────── + ;; + ;; The same four facts `defs' carries, in a buffer: eldoc answers while you + ;; are typing, and a signature in the echo area is gone the moment you do + ;; anything else. Run before the disconnect below, because it reads the + ;; running program. + (flan-doc "step") + (with-current-buffer flan-doc-buffer + (let ((text (buffer-string))) + (test-flan--check "the doc buffer names the thing and its signature" + (and (string-match-p "\\`step" text) + (string-match-p "step \\[\\] i64" text))) + (test-flan--check "and says what kind of thing it is" + (string-match-p "Kind +fn" text)) + )) + ;; Where it is written, for a name that has not been re-installed from a + ;; buffer since the daemon built it: `main' is still at the location the + ;; daemon read it from, which is the ordinary case and the one with a + ;; button on it. + (flan-doc "main") + (with-current-buffer flan-doc-buffer + (test-flan--check "and where a definition is written" + (string-match-p + (regexp-quote (file-name-nondirectory program)) + (buffer-string)))) + ;; A global has no Loc in the Tast, so the buffer says that in the same words + ;; M-. refuses in — rather than leaving the line out, which reads as though + ;; the name had no home at all. + (flan-doc "ticks") + (with-current-buffer flan-doc-buffer + (test-flan--check "a global says why there is no location" + (string-match-p "no location for a var" (buffer-string)))) + (let ((raised nil)) + (condition-case err (flan-doc "no-such-name") + (user-error (setq raised (error-message-string err)))) + (test-flan--check "and a name the program has not got is refused" + (and raised (string-match-p "no no-such-name" raised)))) + (flan-disconnect) (test-flan--check "disconnected" (not (process-live-p flan-dev--connection))) (test-flan--check "and the poll timer is cancelled with it" @@ -524,6 +562,53 @@ is written instead — the real `message' call the real command makes." (user-error (setq raised (error-message-string err)))) (and raised (string-match-p "no such file" raised)))) + ;; ── Navigating a file ───────────────────────────────────────────────── + ;; + ;; No daemon in any of this: imenu and which-function read the buffer, which + ;; is the point — they work on a file nobody has run yet, and they keep + ;; working when the program is stopped or gone. + (with-temp-buffer + (insert ";;;; A file with one of everything.\n" + "(defstruct Missing [id i32])\n" + "(defvar ticks i64)\n" + "(defconst limit i64 10)\n" + "(declare later [] i64)\n" + "(defn step [] i64\n" + " (let [x 1]\n" + " (defn not-top-level [] i64 2)\n" + " (+ ticks x)))\n") + (flan-mode) + (let* ((index (imenu--make-index-alist)) + (group (lambda (name) (cdr (assoc name index))))) + (test-flan--check "imenu finds a function, where it is written" + (equal (marker-position + (cdr (assoc "step" (funcall group "Functions")))) + (save-excursion (goto-char (point-min)) + (search-forward "(defn step") + (match-beginning 0)))) + (test-flan--check "and a struct, under its own heading" + (assoc "Missing" (funcall group "Types"))) + (test-flan--check "and both kinds of global" + (and (assoc "ticks" (funcall group "Variables")) + (assoc "limit" (funcall group "Variables")))) + ;; A forward declaration is not a definition; listing it beside one + ;; would show the same name twice with nothing to tell them apart. + (test-flan--check "and a declaration, said to be one" + (and (assoc "later" (funcall group "Declared")) + (null (assoc "later" (funcall group "Functions"))))) + ;; A `defn' inside a `let' defines nothing at the top level, and the + ;; index is anchored at column 0 so that it cannot offer one. + (test-flan--check "and nothing that is not a top-level form" + (null (assoc "not-top-level" (funcall group "Functions"))))) + ;; which-function: the case is a long body scrolled past its own header. + (goto-char (point-min)) + (search-forward "(+ ticks x)") + (test-flan--check "which-function names the definition point is in" + (equal (flan-current-defun-name) "step")) + (goto-char (point-min)) + (test-flan--check "and says nothing above the first one" + (null (flan-current-defun-name)))) + (if (zerop test-flan--failures) (message "flan-dev.el: all tests passed") (message "\n%d failure(s)" test-flan--failures)