summaryrefslogtreecommitdiff
path: root/elisp
diff options
context:
space:
mode:
authorAaron Marks <nymacro@gmail.com>2018-11-15 19:34:45 +1000
committerAaron Marks <nymacro@gmail.com>2018-11-28 21:52:41 +1000
commit55984b08032ad23eac6a99a749d9e71d972c0964 (patch)
tree970e44537fdc73f483ccfb75224ae84732fa5335 /elisp
parent7ef1cca1241a9e4e6faaac99f58cbc0503d350ad (diff)
downloadgeiser-55984b08032ad23eac6a99a749d9e71d972c0964.tar.gz
geiser-55984b08032ad23eac6a99a749d9e71d972c0964.tar.bz2
Change behaviour of REPL output and highlighting
* Narrow font-lock syntax highlighting to only the active REPL input region. * Mark REPL output read-only. This can be changed via the option `geiser-repl-read-only-output-p`. * Mark REPL output with a user-definable face as `geiser-font-lock-repl-output`. Alternatively an option to syntax highlight REPL output is provided via the option `geiser-repl-highlight-output-p`. This applies scheme-mode syntax highlighting to any REPL output. Any additional hooks defined via scheme-mode-hook are also executed for highlighting this region. * Remove some unwanted TABs in source files.
Diffstat (limited to 'elisp')
-rw-r--r--elisp/geiser-repl.el133
-rw-r--r--elisp/geiser-syntax.el36
2 files changed, 154 insertions, 15 deletions
diff --git a/elisp/geiser-repl.el b/elisp/geiser-repl.el
index f61aba5..3be37b7 100644
--- a/elisp/geiser-repl.el
+++ b/elisp/geiser-repl.el
@@ -26,6 +26,7 @@
(require 'comint)
(require 'compile)
(require 'scheme)
+(require 'font-lock)
;;; Customization:
@@ -98,6 +99,16 @@ change that."
:type 'boolean
:group 'geiser-repl)
+(geiser-custom--defcustom geiser-repl-read-only-output-p t
+ "Whether the REPL's output should be read-only."
+ :type 'boolean
+ :group 'geiser-repl)
+
+(geiser-custom--defcustom geiser-repl-highlight-output-p nil
+ "Whether to syntax highlight REPL output."
+ :type 'boolean
+ :group 'geiser-repl)
+
(geiser-custom--defcustom geiser-repl-auto-indent-p t
"Whether newlines for incomplete sexps are autoindented."
:type 'boolean
@@ -171,6 +182,9 @@ See also `geiser-debug-auto-display-images-p'."
(geiser-custom--defface repl-input
'comint-highlight-input geiser-repl "evaluated input highlighting")
+(geiser-custom--defface repl-output
+ 'font-lock-string-face geiser-repl "REPL output")
+
(geiser-custom--defface repl-prompt
'comint-highlight-prompt geiser-repl "REPL prompt")
@@ -224,6 +238,9 @@ module command as a string")
(defvar geiser-repl--repls nil)
(defvar geiser-repl--closed-repls nil)
+(defvar geiser-repl--last-output-start nil)
+(defvar geiser-repl--last-output-end nil)
+
(make-variable-buffer-local
(defvar geiser-repl--repl nil))
@@ -354,15 +371,91 @@ module command as a string")
(defun geiser-repl--save-remote-data (address)
(setq geiser-repl--address address)
(setq header-line-format
- (cond ((consp address)
- (format "Host: %s Port: %s"
- (geiser-repl--host)
- (geiser-repl--port)))
- ((stringp address)
- (format "Socket: %s" address))
- (t nil))))
+ (cond ((consp address)
+ (format "Host: %s Port: %s"
+ (geiser-repl--host)
+ (geiser-repl--port)))
+ ((stringp address)
+ (format "Socket: %s" address))
+ (t nil))))
+
+(defun geiser-repl--fontify-output-region (beg end)
+ "Apply highlighting to a REPL output region."
+ (remove-text-properties beg end '(font-lock-face nil face nil))
+ (if geiser-repl-highlight-output-p
+ (geiser-syntax--fontify-syntax-region beg end)
+ (geiser-repl--fontify-plaintext beg end)))
+
+(defun geiser-repl--fontify-plaintext (start end)
+ "Fontify REPL output plainly."
+ (add-text-properties
+ start end
+ '(font-lock-fontified t
+ fontified t
+ font-lock-multiline t
+ font-lock-face geiser-font-lock-repl-output)))
+
+
+(defun geiser-repl--narrow-to-prompt ()
+ "Narrow to active prompt region and return t, otherwise returns nil."
+ (let* ((proc (get-buffer-process (current-buffer)))
+ (pmark (and proc (process-mark proc)))
+ (intxt (when (>= (point) (marker-position pmark))
+ (save-excursion
+ (if comint-eol-on-send
+ (if comint-use-prompt-regexp
+ (end-of-line)
+ (goto-char (field-end))))
+ (buffer-substring pmark (point)))))
+ (prompt-beg (marker-position pmark))
+ (prompt-end (+ prompt-beg (length intxt))))
+ (when (> (length intxt) 0)
+ (narrow-to-region prompt-beg prompt-end)
+ t)))
+
+(defun geiser-repl--wrap-fontify-region-function (beg end &optional loudly)
+ (save-restriction
+ (when (geiser-repl--narrow-to-prompt)
+ (let ((font-lock-dont-widen t))
+ (font-lock-default-fontify-region (point-min) (point-max) nil)))))
+
+(defun geiser-repl--wrap-unfontify-region-function (beg end &optional loudly)
+ (save-restriction
+ (when (geiser-repl--narrow-to-prompt)
+ (let ((font-lock-dont-widen t))
+ (font-lock-default-unfontify-region (point-min) (point-max))))))
(defun geiser-repl--output-filter (txt)
+ (let ((mark-output nil))
+ (save-excursion
+ (goto-char (point-max))
+ (re-search-backward comint-prompt-regexp)
+ ;; move to start of line to prevent accidentally marking a REPL prompt
+ (move-to-column 0)
+ ;; Only mark output which:
+ ;; a) is not on the REPL output line
+ ;; b) has at least one character
+ ;;
+ ;; This makes the magic number for distance 3 -- as the newline
+ ;; after executing expression is also counted. This is due to the point
+ ;; being set before comint-send-input.
+ ;;
+ ;; Restriction a) applies due to our inability to distinguish between
+ ;; output from the REPL, and the REPL prompt output.
+ (let ((distance (- (point) geiser-repl--last-output-start)))
+ (when (> distance 2)
+ (setq mark-output t)
+ (set-marker geiser-repl--last-output-end (point)))))
+ (when mark-output
+ (with-silent-modifications
+ (add-text-properties (1+ geiser-repl--last-output-start)
+ geiser-repl--last-output-end
+ `(read-only ,geiser-repl-read-only-output-p))
+ (geiser-repl--fontify-output-region (1+ geiser-repl--last-output-start)
+ geiser-repl--last-output-end)
+ (font-lock-ensure geiser-repl--last-output-start
+ geiser-repl--last-output-end))))
+
(geiser-con--connection-update-debugging geiser-repl--connection txt)
(geiser-image--replace-images geiser-repl-inline-images-p
geiser-repl-auto-display-images-p)
@@ -415,10 +508,10 @@ module command as a string")
(let* ((name (geiser-repl--repl-name impl))
(buff (current-buffer))
(args (cond ((consp address) (list address))
- ((stringp address) '(()))
- (t `(,(geiser-repl--binary impl)
- nil
- ,@(geiser-repl--arglist impl))))))
+ ((stringp address) '(()))
+ (t `(,(geiser-repl--binary impl)
+ nil
+ ,@(geiser-repl--arglist impl))))))
(condition-case err
(if (and address (stringp address))
;; Connect over a Unix-domain socket.
@@ -619,10 +712,12 @@ If SAVE-HISTORY is non-nil, save CMD in the REPL history."
(insert (field-string-no-properties pos))))
(defun geiser-repl--send-input ()
+ (set-marker geiser-repl--last-output-start (point-max))
+
(let* ((proc (get-buffer-process (current-buffer)))
(pmark (and proc (process-mark proc)))
(intxt (and pmark (buffer-substring pmark (point))))
- (eob (point-max)))
+ (eob (point-max)))
(when intxt
(and geiser-repl-forget-old-errors-p
(not (geiser-repl--is-debugging))
@@ -637,9 +732,9 @@ If SAVE-HISTORY is non-nil, save CMD in the REPL history."
(interactive)
(let ((p (point)))
(cond ((< p (geiser-repl--last-prompt-start))
- (if (geiser-repl--is-input)
- (geiser-repl--grab-input)
- (ignore-errors (compile-goto-error))))
+ (if (geiser-repl--is-input)
+ (geiser-repl--grab-input)
+ (ignore-errors (compile-goto-error))))
((let ((inhibit-field-text-motion t))
(end-of-line)
(<= (geiser-repl--nesting-level) 0))
@@ -677,6 +772,8 @@ buffer."
"Major mode for interacting with an inferior scheme repl process.
\\{geiser-repl-mode-map}"
(scheme-mode-variables)
+ (set (make-local-variable 'geiser-repl--last-output-start) (point-marker))
+ (set (make-local-variable 'geiser-repl--last-output-end) (point-marker))
(set (make-local-variable 'face-remapping-alist)
'((comint-highlight-prompt geiser-font-lock-repl-prompt)
(comint-highlight-input geiser-font-lock-repl-input)))
@@ -693,6 +790,12 @@ buffer."
(geiser-completion--setup t)
(setq geiser-smart-tab-mode-string "")
(geiser-smart-tab-mode t)
+
+ (setq-local font-lock-fontify-region-function
+ #'geiser-repl--wrap-fontify-region-function)
+ (setq-local font-lock-unfontify-region-function
+ #'geiser-repl--wrap-unfontify-region-function)
+
;; enabling compilation-shell-minor-mode without the annoying highlighter
(compilation-setup t))
diff --git a/elisp/geiser-syntax.el b/elisp/geiser-syntax.el
index 64b366f..3cc875c 100644
--- a/elisp/geiser-syntax.el
+++ b/elisp/geiser-syntax.el
@@ -495,6 +495,42 @@ implementation-specific entries for font-lock-keywords.")
(font-lock-flush beg end)
(with-no-warnings (font-lock-fontify-region beg end)))))
+;; derived from org-src-font-lock-fontify-block (org-src.el)
+(defun geiser-syntax--fontify-syntax-region (start end)
+ "Fontify region as Scheme."
+ (let ((string (buffer-substring-no-properties start end))
+ (modified (buffer-modified-p))
+ (buffer-undo-list t)
+ (geiser-buffer (current-buffer)))
+ (with-current-buffer
+ (get-buffer-create " *geiser-repl-fontification*")
+ (let ((inhibit-modification-hooks nil))
+ (erase-buffer)
+ ;; Add string and a final space to ensure property change.
+ (insert string " "))
+ ;; prevent geiser prompt
+ (let ((geiser-default-implementation
+ (or geiser-default-implementation
+ (car geiser-active-implementations))))
+ (scheme-mode))
+ (font-lock-ensure)
+ (let ((pos (point-min)) next)
+ (while (setq next (next-property-change pos))
+ ;; Handle additional properties from font-lock, so as to
+ ;; preserve, e.g., composition.
+ (dolist (prop (cons 'face font-lock-extra-managed-props))
+ (let ((new-prop (get-text-property pos prop))
+ (start-point (+ start (1- pos)))
+ (end-point (1- (+ start next))))
+ (put-text-property start-point end-point prop new-prop geiser-buffer)))
+ (setq pos next))))
+ (add-text-properties
+ start end
+ '(font-lock-fontified t
+ fontified t
+ font-lock-multiline t))
+ (set-buffer-modified-p modified)))
+
(defun geiser-syntax--scheme-str (str)
(save-current-buffer
(set-buffer (geiser-syntax--font-lock-buffer))