Skip to content

Commit

Permalink
Support internal prompts
Browse files Browse the repository at this point in the history 
Some people do fancy stuff with the prompt (e.g. multiline, colouring).
This offers some support for it.

The haskell-interactive-mode-prompt-previous/next used the prompt regex
to search for the prompt, but this doesn't work with variable
prompts (i.e. containing module names). Now they use text property
search.
  • Loading branch information
@fice-t
fice-t committed Jun 7, 2016
1 parent cd820dc commit 26414a2
Show file tree
Hide file tree
Showing 5 changed files with 104 additions and 47 deletions.
20 changes: 16 additions & 4 deletions haskell-commands.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -104,9 +104,9 @@ You can create new session using function `haskell-session-make'."
":set -v1"
":set +c") ; :type-at in GHC 8+
"\n"))
(haskell-process-send-string process ":set prompt \"\\4\"")
(haskell-process-send-string process (format ":set prompt2 \"%s\""
haskell-interactive-prompt2)))
haskell-interactive-prompt2))
(haskell-process-send-string process ":set prompt \"\\4\""))

:live (lambda (process buffer)
(when (haskell-process-consume
Expand Down Expand Up @@ -134,8 +134,20 @@ If I break, you can:
1. Restart: M-x haskell-process-restart
2. Configure logging: C-h v haskell-process-log (useful for debugging)
3. General config: M-x customize-mode
4. Hide these tips: C-h v haskell-process-show-debug-tips")))))))

4. Hide these tips: C-h v haskell-process-show-debug-tips")))
(unless haskell-interactive-use-interactive-prompt
(with-current-buffer (haskell-session-interactive-buffer
(haskell-process-session process))
(setq-local haskell-interactive-mode-prompt-start (point-max-marker)))
;; Now it's safe to set the prompt
;; Make sure to double escape any newlines
(haskell-interactive-mode-run-expr
(format ":set prompt \"%s\\4\""
(replace-regexp-in-string "\n"
"\\n"
haskell-interactive-prompt
nil
t))))))))
(defun haskell-commands-process ()
"Get the Haskell session, throws an error if not available."
(or (haskell-session-process (haskell-session-maybe))
Expand Down
11 changes: 11 additions & 0 deletions haskell-customize.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -324,6 +324,17 @@ The default is `haskell-interactive-prompt' with the last > replaced with |."
:type 'string
:group 'haskell-interactive)

(defcustom haskell-interactive-use-interactive-prompt t
"Non-nil means that haskell-interactive uses its prompt at the
Emacs side rather than setting it in GHCi directly.
This is only useful to disable when you want a prompt containing
your modules (as GHCi does by default), or if you apply extra
properties (colours, etc.) to your prompt through GHCi."
:type 'boolean
:group 'haskell-interactive)


(defcustom haskell-interactive-mode-eval-mode
nil
"Use the given mode's font-locking to render some text."
Expand Down
6 changes: 6 additions & 0 deletions haskell-doc.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1517,6 +1517,12 @@ If SYNC is non-nil, make the call synchronously instead."
(setq response nil)
;; Remove a newline at the end
(setq response (replace-regexp-in-string "\n\\'" "" response))
(unless haskell-interactive-use-interactive-prompt
;; Remove the extra prompt (may span multiple lines)
(setq response (mapconcat #'identity
(nbutlast (split-string response "\n")
(1+ (cl-count ?\n haskell-interactive-prompt)))
"\n")))
;; Propertize for eldoc
(save-match-data
(when (string-match " :: " response)
Expand Down
106 changes: 66 additions & 40 deletions haskell-interactive-mode.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -247,7 +247,12 @@ do the
:}"
(if (not (string-match-p "\n" expr))
expr
(let ((len (length haskell-interactive-prompt))
(let ((len (if (or haskell-interactive-use-interactive-prompt
(not (string-match "\n.*\\'" haskell-interactive-prompt)))
(length haskell-interactive-prompt)
(- (match-end 0)
(match-beginning 0)
1)))
(lines (split-string expr "\n")))
(cl-loop for elt on (cdr lines) do
(setcar elt (substring (car elt) len)))
Expand Down Expand Up @@ -295,21 +300,30 @@ do the
(defun haskell-interactive-mode-prompt (&optional session)
"Show a prompt at the end of the REPL buffer.
If SESSION is non-nil, use the REPL buffer associated with
SESSION, otherwise operate on the current buffer."
SESSION, otherwise operate on the current buffer. The prompt
inserted is specified by `haskell-interactive-prompt'.
When `haskell-interactive-use-interactive-prompt' is non-nil,
the prompt is inserted in this function. Otherwise it was already
set in the `haskell-process-send-startup' and has already been
inserted in the buffer by the process."
(with-current-buffer (if session
(haskell-session-interactive-buffer session)
(current-buffer))
(goto-char (point-max))
(let ((prompt (propertize haskell-interactive-prompt
'font-lock-face 'haskell-interactive-face-prompt
'prompt t
'read-only t
'rear-nonsticky t)))
;; At the time of writing, front-stickying the first char gives an error
;; Has unfortunate side-effect of being able to insert before the prompt
(insert (substring prompt 0 1)
(propertize (substring prompt 1)
'front-sticky t)))
(if haskell-interactive-use-interactive-prompt
(let ((prompt (propertize haskell-interactive-prompt
'font-lock-face 'haskell-interactive-face-prompt
'prompt t
'read-only t
'rear-nonsticky t)))
;; At the time of writing, front-stickying the first char gives an error
;; Has unfortunate side-effect of being able to insert before the prompt
(insert (substring prompt 0 1)
(propertize (substring prompt 1)
'front-sticky t)))
(let ((inhibit-read-only t))
(unless (= (point) (point-min))
(put-text-property (1- (point)) (point) 'prompt t))))
(let ((marker (setq-local haskell-interactive-mode-prompt-start (make-marker))))
(set-marker marker (point)))
(when haskell-interactive-mode-scroll-to-bottom
Expand All @@ -322,16 +336,13 @@ SESSION, otherwise operate on the current buffer."
(let ((prop-text (propertize text
'font-lock-face 'haskell-interactive-face-result
'front-sticky t
'prompt t
'read-only t
'rear-nonsticky t
'result t)))
(when (string= text haskell-interactive-prompt2)
(put-text-property 0
(length haskell-interactive-prompt2)
'font-lock-face
'haskell-interactive-face-prompt2
prop-text))
(setq prop-text (propertize prop-text
'font-lock-face 'haskell-interactive-face-prompt2
'prompt2 t)))
(insert (ansi-color-apply prop-text))
(haskell-interactive-mode-handle-h)
(let ((marker (setq-local haskell-interactive-mode-result-end (make-marker))))
Expand Down Expand Up @@ -973,20 +984,34 @@ don't care when the thing completes as long as it's soonish."
(setq haskell-interactive-mode-history-index 0)
(haskell-interactive-mode-history-toggle -1))))

(defun haskell-interactive-mode-prompt-previous ()
"Jump to the previous prompt."
(interactive)
(let ((prev-prompt-pos
(save-excursion
(beginning-of-line) ;; otherwise prompt at current line matches
(and (search-backward-regexp (haskell-interactive-prompt-regex) nil t)
(match-end 0)))))
(when prev-prompt-pos (goto-char prev-prompt-pos))))

(defun haskell-interactive-mode-prompt-next ()
"Jump to the next prompt."
(interactive)
(search-forward-regexp (haskell-interactive-prompt-regex) nil t))
(defun haskell-interactive-mode-prompt-previous (&optional arg)
"Jump to the ARGth previous prompt."
(interactive "p")
(if (< arg 0)
(haskell-interactive-mode-prompt-next (- arg))
(end-of-line 1)
(unless (or (get-text-property (1- (point)) 'prompt)
(zerop arg))
(cl-incf arg 0.5)) ; do it an extra time if not at a prompt
(dotimes (_ (* 2 arg))
(goto-char (or (previous-single-property-change (point) 'prompt)
(point))))
(when (get-text-property (point) 'prompt)
;; went too far (at first prompt)
(goto-char (next-single-property-change (point) 'prompt)))))

(defun haskell-interactive-mode-prompt-next (&optional arg)
"Jump to the ARGth next prompt."
(interactive "p")
(if (< arg 0)
(haskell-interactive-mode-prompt-previous (- arg))
(when (and (get-text-property (point) 'prompt)
(not (zerop arg)))
;; don't start on a prompt
(haskell-interactive-mode-prompt-previous 1))
(dotimes (_ (* 2 arg))
(goto-char (or (next-single-property-change (point) 'prompt)
(point-max))))))

(defun haskell-interactive-mode-clear ()
"Clear the screen and put any current input into the history."
Expand Down Expand Up @@ -1054,14 +1079,15 @@ If there is one, pop that up in a buffer, similar to `debug-on-error'."
(with-current-buffer (haskell-session-interactive-buffer session)
(save-excursion
(haskell-interactive-mode-goto-end-point)
(insert (if mode
(haskell-fontify-as-mode
(concat message "\n")
mode)
(propertize (concat message "\n")
'front-sticky t
'read-only t
'rear-nonsticky t))))))
(let ((inhibit-read-only t))
(insert (if mode
(haskell-fontify-as-mode
(concat message "\n")
mode)
(propertize (concat message "\n")
'front-sticky t
'read-only t
'rear-nonsticky t)))))))

(defun haskell-interactive-mode-splices-buffer (session)
"Get the splices buffer for the current SESSION."
Expand Down
8 changes: 5 additions & 3 deletions haskell-repl.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -23,7 +23,8 @@
(defun haskell-interactive-handle-expr ()
"Handle an inputted expression at the REPL."
(let ((expr (haskell-interactive-mode-input)))
(if (string= "" (replace-regexp-in-string " " "" expr))
(if (and (string= "" (replace-regexp-in-string " " "" expr))
haskell-interactive-use-interactive-prompt)
;; Just make a new prompt on space-only input
(progn
(goto-char (point-max))
Expand Down Expand Up @@ -116,8 +117,9 @@
(delete-region (1+ haskell-interactive-mode-prompt-start) (point))
(goto-char (point-max))
(let ((start (point)))
(insert (haskell-fontify-as-mode text
haskell-interactive-mode-eval-mode))
(insert (ansi-color-apply (haskell-fontify-as-mode
text
haskell-interactive-mode-eval-mode)))
(when haskell-interactive-mode-collapse
(haskell-collapse start (point)))))))

Expand Down

0 comments on commit 26414a2

Please sign in to comment.