Support internal prompts

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.

haskell-commands.el

@@ -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
@@ -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))

haskell-customize.el

@@ -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."

haskell-doc.el

@@ -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)

haskell-interactive-mode.el

@@ -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)))
@@ -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
@@ -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))))
@@ -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."
@@ -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."

haskell-repl.el

@@ -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))
@@ -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)))))))