geiser-repl.el (39981B)
1 ;;; geiser-repl.el --- Geiser's REPL 2 3 ;; Copyright (C) 2009, 2010, 2011, 2012, 2013, 2015, 2016, 2018, 2019, 2020 Jose Antonio Ortega Ruiz 4 5 ;; This program is free software; you can redistribute it and/or 6 ;; modify it under the terms of the Modified BSD License. You should 7 ;; have received a copy of the license along with this program. If 8 ;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>. 9 10 11 ;;; Code: 12 13 (require 'geiser-company) 14 (require 'geiser-doc) 15 (require 'geiser-autodoc) 16 (require 'geiser-edit) 17 (require 'geiser-completion) 18 (require 'geiser-syntax) 19 (require 'geiser-impl) 20 (require 'geiser-eval) 21 (require 'geiser-connection) 22 (require 'geiser-menu) 23 (require 'geiser-image) 24 (require 'geiser-custom) 25 (require 'geiser-base) 26 27 (require 'comint) 28 (require 'compile) 29 (require 'scheme) 30 (require 'font-lock) 31 32 33 ;;; Customization: 34 35 (defgroup geiser-repl nil 36 "Interacting with the Geiser REPL." 37 :group 'geiser) 38 39 (geiser-custom--defcustom geiser-repl-buffer-name-function 40 'geiser-repl-buffer-name 41 "Function used to define the name of a REPL buffer. 42 The function is called with a single argument - an implementation 43 symbol (e.g., `guile', `chicken', etc.)." 44 :type '(choice (function-item geiser-repl-buffer-name) 45 (function :tag "Other function")) 46 :group 'geiser-repl) 47 48 (geiser-custom--defcustom geiser-repl-current-project-function 49 'ignore 50 "Function used to determine the current project. 51 The function is called from both source and REPL buffers, and 52 should return a value which uniquely identifies the project." 53 :type '(choice (function-item :tag "Ignore projects" ignore) 54 (function-item :tag "Use Project.el" project-current) 55 (function-item :tag "Use Projectile" projectile-project-root) 56 (function :tag "Other function")) 57 :group 'geiser-repl) 58 59 (geiser-custom--defcustom geiser-repl-use-other-window t 60 "Whether to Use a window other than the current buffer's when 61 switching to the Geiser REPL buffer." 62 :type 'boolean 63 :group 'geiser-repl) 64 65 (geiser-custom--defcustom geiser-repl-window-allow-split t 66 "Whether to allow window splitting when switching to the Geiser REPL buffer." 67 :type 'boolean 68 :group 'geiser-repl) 69 70 (geiser-custom--defcustom geiser-repl-history-filename 71 (expand-file-name "~/.geiser_history") 72 "File where REPL input history is saved, so that it persists between sessions. 73 74 This is actually the base name: the concrete Scheme 75 implementation name gets appended to it." 76 :type 'file 77 :group 'geiser-repl) 78 79 (geiser-custom--defcustom geiser-repl-history-size comint-input-ring-size 80 "Maximum size of the saved REPL input history." 81 :type 'integer 82 :group 'geiser-repl) 83 84 (geiser-custom--defcustom geiser-repl-history-no-dups-p t 85 "Whether to skip duplicates when recording history." 86 :type 'boolean 87 :group 'geiser-repl) 88 89 (geiser-custom--defcustom geiser-repl-save-debugging-history-p nil 90 "Whether to skip debugging input in REPL history. 91 92 By default, REPL interactions while scheme is in the debugger are 93 not added to the REPL command history. Set this variable to t to 94 change that." 95 :type 'boolean 96 :group 'geiser-repl) 97 98 (geiser-custom--defcustom geiser-repl-autodoc-p t 99 "Whether to enable `geiser-autodoc-mode' in the REPL by default." 100 :type 'boolean 101 :group 'geiser-repl) 102 103 (geiser-custom--defcustom geiser-repl-company-p t 104 "Whether to use company-mode for completion, if available." 105 :group 'geiser-mode 106 :type 'boolean) 107 108 (geiser-custom--defcustom geiser-repl-read-only-prompt-p t 109 "Whether the REPL's prompt should be read-only." 110 :type 'boolean 111 :group 'geiser-repl) 112 113 (geiser-custom--defcustom geiser-repl-read-only-output-p t 114 "Whether the REPL's output should be read-only." 115 :type 'boolean 116 :group 'geiser-repl) 117 118 (geiser-custom--defcustom geiser-repl-highlight-output-p nil 119 "Whether to syntax highlight REPL output." 120 :type 'boolean 121 :group 'geiser-repl) 122 123 (geiser-custom--defcustom geiser-repl-auto-indent-p t 124 "Whether newlines for incomplete sexps are autoindented." 125 :type 'boolean 126 :group 'geiser-repl) 127 128 (geiser-custom--defcustom geiser-repl-send-on-return-p t 129 "Sends input to REPL when ENTER is pressed in a balanced S-expression, 130 regardless of cursor positioning. 131 132 When off, pressing ENTER inside a balance S-expression will 133 introduce a new line without sending input to the inferior 134 Scheme process. This option is useful when using minor modes 135 which might do parentheses balancing, or when entering additional 136 arguments inside an existing expression. 137 138 When on (the default), pressing ENTER inside a balanced S-expression 139 will send the input to the inferior Scheme process regardless of the 140 cursor placement." 141 :type 'boolean 142 :group 'geiser-repl) 143 144 (geiser-custom--defcustom geiser-repl-forget-old-errors-p t 145 "Whether to forget old errors upon entering a new expression. 146 147 When on (the default), every time a new expression is entered in 148 the REPL old error messages are flushed, and using \\[next-error] 149 afterwards will jump only to error locations produced by the new 150 expression, if any." 151 :type 'boolean 152 :group 'geiser-repl) 153 154 (geiser-custom--defcustom geiser-repl-skip-version-check-p nil 155 "Whether to skip version checks for the Scheme executable. 156 157 When set, Geiser won't check the version of the Scheme 158 interpreter when starting a REPL, saving a few tenths of a 159 second." 160 :type 'boolean 161 :group 'geiser-repl) 162 163 (geiser-custom--defcustom geiser-repl-query-on-exit-p nil 164 "Whether to prompt for confirmation on \\[geiser-repl-exit]." 165 :type 'boolean 166 :group 'geiser-repl) 167 168 (geiser-custom--defcustom geiser-repl-delete-last-output-on-exit-p nil 169 "Whether to delete partial outputs when the REPL's process exits." 170 :type 'boolean 171 :group 'geiser-repl) 172 173 (geiser-custom--defcustom geiser-repl-query-on-kill-p t 174 "Whether to prompt for confirmation when killing a REPL buffer with 175 a life process." 176 :type 'boolean 177 :group 'geiser-repl) 178 179 (geiser-custom--defcustom geiser-repl-default-host "localhost" 180 "Default host when connecting to remote REPLs." 181 :type 'string 182 :group 'geiser-repl) 183 184 (geiser-custom--defcustom geiser-repl-default-port 37146 185 "Default port for connecting to remote REPLs." 186 :type 'integer 187 :group 'geiser-repl) 188 189 (geiser-custom--defcustom geiser-repl-startup-time 10000 190 "Time, in milliseconds, to wait for Racket to startup. 191 If you have a slow system, try to increase this time." 192 :type 'integer 193 :group 'geiser-repl) 194 195 (geiser-custom--defcustom geiser-repl-inline-images-p t 196 "Whether to display inline images in the REPL." 197 :type 'boolean 198 :group 'geiser-repl) 199 200 (geiser-custom--defcustom geiser-repl-auto-display-images-p t 201 "Whether to automatically invoke the external viewer to display 202 images popping up in the REPL. 203 204 See also `geiser-debug-auto-display-images-p'." 205 :type 'boolean 206 :group 'geiser-repl) 207 208 (geiser-custom--defface repl-input 209 'comint-highlight-input geiser-repl "evaluated input highlighting") 210 211 (geiser-custom--defface repl-output 212 'font-lock-string-face geiser-repl "REPL output") 213 214 (geiser-custom--defface repl-prompt 215 'comint-highlight-prompt geiser-repl "REPL prompt") 216 217 218 219 ;;; Implementation-dependent parameters 220 221 (geiser-impl--define-caller geiser-repl--binary binary () 222 "A variable or function returning the path to the scheme binary 223 for this implementation.") 224 225 (geiser-impl--define-caller geiser-repl--arglist arglist () 226 "A function taking no arguments and returning a list of 227 arguments to be used when invoking the scheme binary.") 228 229 (geiser-impl--define-caller geiser-repl--prompt-regexp prompt-regexp () 230 "A variable (or thunk returning a value) giving the regular 231 expression for this implementation's geiser scheme prompt.") 232 233 (geiser-impl--define-caller 234 geiser-repl--debugger-prompt-regexp debugger-prompt-regexp () 235 "A variable (or thunk returning a value) giving the regular 236 expression for this implementation's debugging prompt.") 237 238 (geiser-impl--define-caller geiser-repl--startup repl-startup (remote) 239 "Function taking no parameters that is called after the REPL 240 has been initialised. All Geiser functionality is available to 241 you at that point.") 242 243 (geiser-impl--define-caller geiser-repl--enter-cmd enter-command (module) 244 "Function taking a module designator and returning a REPL enter 245 module command as a string") 246 247 (geiser-impl--define-caller geiser-repl--import-cmd import-command (module) 248 "Function taking a module designator and returning a REPL import 249 module command as a string") 250 251 (geiser-impl--define-caller geiser-repl--exit-cmd exit-command () 252 "Function returning the REPL exit command as a string") 253 254 (geiser-impl--define-caller geiser-repl--version version-command (binary) 255 "Function returning the version of the corresponding scheme process, 256 given its full path.") 257 258 (geiser-impl--define-caller geiser-repl--min-version minimum-version () 259 "A variable providing the minimum required scheme version, as a string.") 260 261 262 ;;; Geiser REPL buffers and processes: 263 264 (defvar geiser-repl--repls nil) 265 (defvar geiser-repl--closed-repls nil) 266 267 (defvar geiser-repl--last-output-start nil) 268 (defvar geiser-repl--last-output-end nil) 269 270 (defvar-local geiser-repl--repl nil) 271 272 (defvar-local geiser-repl--project nil) 273 274 (defsubst geiser-repl--set-this-buffer-repl (r) 275 (setq geiser-repl--repl r)) 276 277 (defsubst geiser-repl--set-this-buffer-project (p) 278 (setq geiser-repl--project p)) 279 280 (defsubst geiser-repl--current-project () 281 (or (funcall geiser-repl-current-project-function) 282 'no-project)) 283 284 (defun geiser-repl--live-p () 285 (and geiser-repl--repl 286 (get-buffer-process geiser-repl--repl))) 287 288 (defun geiser-repl--repl/impl (impl &optional proj repls) 289 (let ((proj (or proj 290 geiser-repl--project 291 (geiser-repl--current-project))) 292 (repls (or repls 293 geiser-repl--repls))) 294 (catch 'repl 295 (dolist (repl repls) 296 (when (buffer-live-p repl) 297 (with-current-buffer repl 298 (when (and (eq geiser-impl--implementation impl) 299 (equal geiser-repl--project proj)) 300 (throw 'repl repl)))))))) 301 302 (defun geiser-repl--set-up-repl (impl) 303 (or (and (not impl) geiser-repl--repl) 304 (setq geiser-repl--repl 305 (let ((impl (or impl 306 geiser-impl--implementation 307 (geiser-impl--guess)))) 308 (when impl (geiser-repl--repl/impl impl)))))) 309 310 (defun geiser-repl--active-impls () 311 (let ((act)) 312 (dolist (repl geiser-repl--repls act) 313 (with-current-buffer repl 314 (add-to-list 'act geiser-impl--implementation))))) 315 316 (defsubst geiser-repl--repl-name (impl) 317 (format "%s REPL" (geiser-impl--impl-str impl))) 318 319 (defsubst geiser-repl--buffer-name (impl) 320 (funcall geiser-repl-buffer-name-function impl)) 321 322 (defun geiser-repl-buffer-name (impl) 323 "Return default name of the REPL buffer for implementation IMPL." 324 (format "* %s *" (geiser-repl--repl-name impl))) 325 326 (defun geiser-repl--switch-to-buffer (buffer) 327 (unless (eq buffer (current-buffer)) 328 (let ((pop-up-windows geiser-repl-window-allow-split)) 329 (if geiser-repl-use-other-window 330 (switch-to-buffer-other-window buffer) 331 (switch-to-buffer buffer))))) 332 333 (defun geiser-repl--to-repl-buffer (impl) 334 (unless (and (eq major-mode 'geiser-repl-mode) 335 (eq geiser-impl--implementation impl) 336 (not (get-buffer-process (current-buffer)))) 337 (let* ((proj (geiser-repl--current-project)) 338 (old (geiser-repl--repl/impl impl proj geiser-repl--closed-repls)) 339 (old (and (buffer-live-p old) 340 (not (get-buffer-process old)) 341 old))) 342 (geiser-repl--switch-to-buffer 343 (or old (generate-new-buffer (geiser-repl--buffer-name impl)))) 344 (unless old 345 (geiser-repl-mode) 346 (geiser-impl--set-buffer-implementation impl) 347 (geiser-repl--set-this-buffer-project proj) 348 (geiser-syntax--add-kws t))))) 349 350 (defun geiser-repl--read-impl (prompt &optional active) 351 (geiser-impl--read-impl prompt (and active (geiser-repl--active-impls)))) 352 353 (defsubst geiser-repl--only-impl-p () 354 (and (null (cdr geiser-active-implementations)) 355 (car geiser-active-implementations))) 356 357 (defun geiser-repl--get-impl (prompt) 358 (or (geiser-repl--only-impl-p) 359 (and (eq major-mode 'geiser-repl-mode) geiser-impl--implementation) 360 (geiser-repl--read-impl prompt))) 361 362 363 ;;; Prompt &co. 364 365 (defun geiser-repl--last-prompt-end () 366 (cond ((and (boundp 'comint-last-prompt) (markerp (cdr comint-last-prompt))) 367 (marker-position (cdr comint-last-prompt))) 368 ((and (boundp 'comint-last-prompt-overlay) comint-last-prompt-overlay) 369 (overlay-end comint-last-prompt-overlay)) 370 (t (save-excursion 371 (geiser-repl--bol) 372 (min (+ 1 (point)) (point-max)))))) 373 374 (defun geiser-repl--last-prompt-start () 375 (cond ((and (boundp 'comint-last-prompt) (markerp (car comint-last-prompt))) 376 (marker-position (car comint-last-prompt))) 377 ((and (boundp 'comint-last-prompt-overlay) comint-last-prompt-overlay) 378 (overlay-start comint-last-prompt-overlay)) 379 (t (save-excursion (geiser-repl--bol) (point))))) 380 381 382 ;;; REPL connections 383 384 (defvar-local geiser-repl--address nil) 385 386 (defvar-local geiser-repl--connection nil) 387 388 (defun geiser-repl--local-p () 389 "Return non-nil, if current REPL is local (connected to socket)." 390 (stringp geiser-repl--address)) 391 392 (defun geiser-repl--remote-p () 393 "Return non-nil, if current REPL is remote (connected to host:port)." 394 (consp geiser-repl--address)) 395 396 (defsubst geiser-repl--host () (car geiser-repl--address)) 397 (defsubst geiser-repl--port () (cdr geiser-repl--address)) 398 399 (defun geiser-repl--read-address (&optional host port) 400 (let ((defhost (or (geiser-repl--host) geiser-repl-default-host)) 401 (defport (or (geiser-repl--port) geiser-repl-default-port))) 402 (cons (or host 403 (read-string (format "Host (default %s): " defhost) 404 nil nil defhost)) 405 (or port (read-number "Port: " defport))))) 406 407 (defun geiser-repl--autodoc-mode (n) 408 (when (or geiser-repl-autodoc-p (< n 0)) 409 (geiser--save-msg (geiser-autodoc-mode n)))) 410 411 (defun geiser-repl--save-remote-data (address) 412 (setq geiser-repl--address address) 413 (cond ((consp address) 414 (setq header-line-format 415 (format "Host: %s Port: %s" 416 (geiser-repl--host) 417 (geiser-repl--port)))) 418 ((stringp address) 419 (setq header-line-format 420 (format "Socket: %s" address))))) 421 422 (defun geiser-repl--fontify-output-region (beg end) 423 "Apply highlighting to a REPL output region." 424 (remove-text-properties beg end '(font-lock-face nil face nil)) 425 (if geiser-repl-highlight-output-p 426 (geiser-syntax--fontify-syntax-region beg end) 427 (geiser-repl--fontify-plaintext beg end))) 428 429 (defun geiser-repl--fontify-plaintext (start end) 430 "Fontify REPL output plainly." 431 (add-text-properties 432 start end 433 '(font-lock-fontified t 434 fontified t 435 font-lock-multiline t 436 font-lock-face geiser-font-lock-repl-output))) 437 438 (defun geiser-repl--narrow-to-prompt () 439 "Narrow to active prompt region and return t, otherwise returns nil." 440 (let* ((proc (get-buffer-process (current-buffer))) 441 (pmark (and proc (process-mark proc))) 442 (intxt (when (>= (point) (marker-position pmark)) 443 (save-excursion 444 (if comint-eol-on-send 445 (if comint-use-prompt-regexp 446 (end-of-line) 447 (goto-char (field-end)))) 448 (buffer-substring pmark (point))))) 449 (prompt-beg (marker-position pmark)) 450 (prompt-end (+ prompt-beg (length intxt)))) 451 (when (> (length intxt) 0) 452 (narrow-to-region prompt-beg prompt-end) 453 t))) 454 455 (defun geiser-repl--wrap-fontify-region-function (beg end &optional loudly) 456 (save-restriction 457 (when (geiser-repl--narrow-to-prompt) 458 (let ((font-lock-dont-widen t)) 459 (font-lock-default-fontify-region (point-min) (point-max) nil))))) 460 461 (defun geiser-repl--wrap-unfontify-region-function (beg end &optional loudly) 462 (save-restriction 463 (when (geiser-repl--narrow-to-prompt) 464 (let ((font-lock-dont-widen t)) 465 (font-lock-default-unfontify-region (point-min) (point-max)))))) 466 467 (defun geiser-repl--output-filter (txt) 468 (let ((mark-output nil)) 469 (save-excursion 470 (goto-char (point-max)) 471 (re-search-backward comint-prompt-regexp) 472 ;; move to start of line to prevent accidentally marking a REPL prompt 473 (move-to-column 0) 474 ;; Only mark output which: 475 ;; a) is not on the REPL output line 476 ;; b) has at least one character 477 ;; 478 ;; This makes the magic number for distance 3 -- as the newline 479 ;; after executing expression is also counted. This is due to the point 480 ;; being set before comint-send-input. 481 ;; 482 ;; Restriction a) applies due to our inability to distinguish between 483 ;; output from the REPL, and the REPL prompt output. 484 (let ((distance (- (point) geiser-repl--last-output-start))) 485 (when (> distance 2) 486 (setq mark-output t) 487 (set-marker geiser-repl--last-output-end (point))))) 488 (when mark-output 489 (with-silent-modifications 490 (add-text-properties (1+ geiser-repl--last-output-start) 491 geiser-repl--last-output-end 492 `(read-only ,geiser-repl-read-only-output-p)) 493 (geiser-repl--fontify-output-region geiser-repl--last-output-start 494 geiser-repl--last-output-end) 495 (geiser--font-lock-ensure geiser-repl--last-output-start 496 geiser-repl--last-output-end)))) 497 498 (geiser-con--connection-update-debugging geiser-repl--connection txt) 499 (geiser-image--replace-images geiser-repl-inline-images-p 500 geiser-repl-auto-display-images-p) 501 (when (string-match-p (geiser-con--connection-prompt geiser-repl--connection) 502 txt) 503 (geiser-autodoc--disinhibit-autodoc))) 504 505 (defun geiser-repl--check-version (impl) 506 (when (not geiser-repl-skip-version-check-p) 507 (let ((v (geiser-repl--version impl (geiser-repl--binary impl))) 508 (r (geiser-repl--min-version impl))) 509 (when (and v r (geiser--version< v r)) 510 (error "Geiser requires %s version %s but detected %s" impl r v))))) 511 512 (defvar geiser-repl--last-scm-buffer) 513 514 (defun geiser-repl--start-repl (impl address) 515 (message "Starting Geiser REPL ...") 516 (when (not address) (geiser-repl--check-version impl)) 517 (let ((buffer (current-buffer)) 518 (binary (geiser-repl--binary impl)) 519 (arglist (geiser-repl--arglist impl))) 520 (geiser-repl--to-repl-buffer impl) 521 (setq geiser-repl--last-scm-buffer buffer 522 geiser-repl--binary binary 523 geiser-repl--arglist arglist)) 524 (sit-for 0) 525 (goto-char (point-max)) 526 (geiser-repl--autodoc-mode -1) 527 (let* ((prompt-rx (geiser-repl--prompt-regexp impl)) 528 (deb-prompt-rx (geiser-repl--debugger-prompt-regexp impl)) 529 (prompt (geiser-con--combined-prompt prompt-rx deb-prompt-rx))) 530 (unless prompt-rx 531 (error "Sorry, I don't know how to start a REPL for %s" impl)) 532 (geiser-repl--save-remote-data address) 533 (geiser-repl--start-scheme impl address prompt) 534 (geiser-repl--quit-setup) 535 (geiser-repl--history-setup) 536 (add-to-list 'geiser-repl--repls (current-buffer)) 537 (geiser-repl--set-this-buffer-repl (current-buffer)) 538 (setq geiser-repl--connection 539 (geiser-con--make-connection (get-buffer-process (current-buffer)) 540 prompt-rx 541 deb-prompt-rx)) 542 (geiser-repl--startup impl address) 543 (geiser-repl--autodoc-mode 1) 544 (geiser-company--setup geiser-repl-company-p) 545 (add-hook 'comint-output-filter-functions 546 'geiser-repl--output-filter 547 nil 548 t) 549 (set-process-query-on-exit-flag (get-buffer-process (current-buffer)) 550 geiser-repl-query-on-kill-p) 551 (message "%s up and running!" (geiser-repl--repl-name impl)))) 552 553 (defun geiser-repl--start-scheme (impl address prompt) 554 (setq comint-prompt-regexp prompt) 555 (let* ((name (geiser-repl--repl-name impl)) 556 (buff (current-buffer)) 557 (args (cond ((consp address) (list address)) 558 ((stringp address) '(())) 559 (t `(,(geiser-repl--get-binary impl) 560 nil 561 ,@(geiser-repl--get-arglist impl)))))) 562 (condition-case err 563 (if (and address (stringp address)) 564 ;; Connect over a Unix-domain socket. 565 (let ((proc (make-network-process :name (buffer-name buff) 566 :buffer buff 567 :family 'local 568 :remote address))) 569 ;; brittleness warning: this is stuff 570 ;; make-comint-in-buffer sets up, via comint-exec, when 571 ;; it creates its own process, something we're doing 572 ;; here by ourselves. 573 (set-process-filter proc 'comint-output-filter) 574 (goto-char (point-max)) 575 (set-marker (process-mark proc) (point))) 576 (apply 'make-comint-in-buffer `(,name ,buff ,@args))) 577 (error (insert "Unable to start REPL:\n" 578 (error-message-string err) 579 "\n") 580 (error "Couldn't start Geiser: %s" err))) 581 (geiser-repl--wait-for-prompt geiser-repl-startup-time))) 582 583 (defun geiser-repl--wait-for-prompt (timeout) 584 (let ((p (point)) (seen) (buffer (current-buffer))) 585 (while (and (not seen) 586 (> timeout 0) 587 (get-buffer-process buffer)) 588 (sleep-for 0.1) 589 (setq timeout (- timeout 100)) 590 (goto-char p) 591 (setq seen (re-search-forward comint-prompt-regexp nil t))) 592 (goto-char (point-max)) 593 (unless seen (error "%s" "No prompt found!")))) 594 595 (defun geiser-repl--is-debugging () 596 (let ((dp (geiser-con--connection-debug-prompt geiser-repl--connection))) 597 (and dp 598 (save-excursion 599 (goto-char (geiser-repl--last-prompt-start)) 600 (re-search-forward dp (geiser-repl--last-prompt-end) t))))) 601 602 (defun geiser-repl--connection* () 603 (let ((buffer (geiser-repl--set-up-repl geiser-impl--implementation))) 604 (and (buffer-live-p buffer) 605 (get-buffer-process buffer) 606 (with-current-buffer buffer geiser-repl--connection)))) 607 608 (defun geiser-repl--connection () 609 (or (geiser-repl--connection*) 610 (error "No Geiser REPL for this buffer (try M-x run-geiser)"))) 611 612 (setq geiser-eval--default-connection-function 'geiser-repl--connection) 613 614 (defun geiser-repl--prepare-send () 615 (geiser-image--clean-cache) 616 (geiser-autodoc--inhibit-autodoc) 617 (geiser-con--connection-deactivate geiser-repl--connection)) 618 619 (defun geiser-repl--send (cmd &optional save-history) 620 "Send CMD input string to the current REPL buffer. 621 If SAVE-HISTORY is non-nil, save CMD in the REPL history." 622 (when (and cmd (eq major-mode 'geiser-repl-mode)) 623 (geiser-repl--prepare-send) 624 (goto-char (point-max)) 625 (comint-kill-input) 626 (insert cmd) 627 (let ((comint-input-filter (if save-history 628 comint-input-filter 629 'ignore))) 630 (comint-send-input nil t)))) 631 632 (defun geiser-repl-interrupt () 633 (interactive) 634 (when (get-buffer-process (current-buffer)) 635 (interrupt-process nil comint-ptyp))) 636 637 638 ;;; REPL history 639 640 (defconst geiser-repl--history-separator "\n}{\n") 641 642 (defsubst geiser-repl--history-file () 643 (format "%s.%s" geiser-repl-history-filename geiser-impl--implementation)) 644 645 (defun geiser-repl--read-input-ring () 646 (let ((comint-input-ring-file-name (geiser-repl--history-file)) 647 (comint-input-ring-separator geiser-repl--history-separator) 648 (buffer-file-coding-system 'utf-8)) 649 (comint-read-input-ring t))) 650 651 (defun geiser-repl--write-input-ring () 652 (let ((comint-input-ring-file-name (geiser-repl--history-file)) 653 (comint-input-ring-separator geiser-repl--history-separator) 654 (buffer-file-coding-system 'utf-8)) 655 (comint-write-input-ring))) 656 657 (defun geiser-repl--history-setup () 658 (set (make-local-variable 'comint-input-ring-size) geiser-repl-history-size) 659 (set (make-local-variable 'comint-input-filter) 'geiser-repl--input-filter) 660 (geiser-repl--read-input-ring)) 661 662 663 ;;; Cleaning up 664 665 (defun geiser-repl--on-quit () 666 (geiser-repl--write-input-ring) 667 (let ((cb (current-buffer)) 668 (impl geiser-impl--implementation) 669 (comint-prompt-read-only nil)) 670 (geiser-con--connection-deactivate geiser-repl--connection t) 671 (geiser-con--connection-close geiser-repl--connection) 672 (setq geiser-repl--repls (remove cb geiser-repl--repls)) 673 (dolist (buffer (buffer-list)) 674 (when (buffer-live-p buffer) 675 (with-current-buffer buffer 676 (when (and (eq geiser-impl--implementation impl) 677 (equal cb geiser-repl--repl)) 678 (geiser-repl--set-up-repl geiser-impl--implementation))))))) 679 680 (defun geiser-repl--sentinel (proc event) 681 (let ((pb (process-buffer proc))) 682 (when (buffer-live-p pb) 683 (with-current-buffer pb 684 (let ((comint-prompt-read-only nil) 685 (comint-input-ring-file-name (geiser-repl--history-file)) 686 (comint-input-ring-separator geiser-repl--history-separator)) 687 (geiser-repl--on-quit) 688 (push pb geiser-repl--closed-repls) 689 (goto-char (point-max)) 690 (when geiser-repl-delete-last-output-on-exit-p 691 (comint-kill-region comint-last-input-start (point))) 692 (insert "\nIt's been nice interacting with you!\n") 693 (insert 694 (substitute-command-keys 695 "Press \\[switch-to-geiser] to bring me back.\n"))))))) 696 697 (defun geiser-repl--on-kill () 698 (geiser-repl--on-quit) 699 (setq geiser-repl--closed-repls 700 (remove (current-buffer) geiser-repl--closed-repls))) 701 702 (defun geiser-repl--input-filter (str) 703 (not (or (and (not geiser-repl-save-debugging-history-p) 704 (geiser-repl--is-debugging)) 705 (string-match "^\\s *$" str) 706 (string-match "^,quit *$" str)))) 707 708 (defun geiser-repl--old-input () 709 (save-excursion 710 (let ((end (point))) 711 (backward-sexp) 712 (buffer-substring (point) end)))) 713 714 (defun geiser-repl--quit-setup () 715 (add-hook 'kill-buffer-hook 'geiser-repl--on-kill nil t) 716 (set-process-sentinel (get-buffer-process (current-buffer)) 717 'geiser-repl--sentinel)) 718 719 720 ;;; geiser-repl mode: 721 722 (defun geiser-repl--bol () 723 (interactive) 724 (when (= (point) (comint-bol)) (beginning-of-line))) 725 726 (defun geiser-repl--beginning-of-defun () 727 (save-restriction 728 (narrow-to-region (geiser-repl--last-prompt-end) (point)) 729 (let ((beginning-of-defun-function nil)) 730 (beginning-of-defun)))) 731 732 (defun geiser-repl--module-function (&optional module) 733 (if (and module geiser-eval--get-impl-module) 734 (funcall geiser-eval--get-impl-module module) 735 :f)) 736 737 (defun geiser-repl--doc-module () 738 (interactive) 739 (let ((geiser-eval--get-module-function 740 (geiser-impl--method 'find-module geiser-impl--implementation))) 741 (geiser-doc-module))) 742 743 (defun geiser-repl--newline-and-indent () 744 (interactive) 745 (save-restriction 746 (narrow-to-region comint-last-input-start (point-max)) 747 (insert "\n") 748 (lisp-indent-line))) 749 750 (defun geiser-repl--nesting-level () 751 (save-restriction 752 (narrow-to-region (geiser-repl--last-prompt-end) (point-max)) 753 (geiser-syntax--nesting-level))) 754 755 (defun geiser-repl--is-input () 756 (not (eq (field-at-pos (point)) 'output))) 757 758 (defun geiser-repl--grab-input () 759 (let ((pos (comint-bol))) 760 (goto-char (point-max)) 761 (insert (field-string-no-properties pos)))) 762 763 (defun geiser-repl--send-input () 764 (set-marker geiser-repl--last-output-start (point-max)) 765 766 (let* ((proc (get-buffer-process (current-buffer))) 767 (pmark (and proc (process-mark proc))) 768 (intxt (and pmark (buffer-substring pmark (point)))) 769 (eob (point-max))) 770 (when intxt 771 (and geiser-repl-forget-old-errors-p 772 (not (geiser-repl--is-debugging)) 773 (compilation-forget-errors)) 774 (geiser-repl--prepare-send) 775 (comint-send-input) 776 (when (string-match "^\\s-*$" intxt) 777 (comint-send-string proc (geiser-eval--scheme-str '(:ge no-values))) 778 (comint-send-string proc "\n"))))) 779 780 (defun geiser-repl--maybe-send () 781 (interactive) 782 (let ((p (point))) 783 (cond ((< p (geiser-repl--last-prompt-start)) 784 (if (geiser-repl--is-input) 785 (geiser-repl--grab-input) 786 (ignore-errors (compile-goto-error)))) 787 ((let ((inhibit-field-text-motion t)) 788 (when geiser-repl-send-on-return-p 789 (end-of-line)) 790 (<= (geiser-repl--nesting-level) 0)) 791 (geiser-repl--send-input)) 792 (t (goto-char p) 793 (if geiser-repl-auto-indent-p 794 (geiser-repl--newline-and-indent) 795 (insert "\n")))))) 796 797 (defun geiser-repl-tab-dwim (n) 798 "If we're after the last prompt, complete symbol or indent (if 799 there's no symbol at point). Otherwise, go to next error in the REPL 800 buffer." 801 (interactive "p") 802 (if (>= (point) (geiser-repl--last-prompt-end)) 803 (or (completion-at-point) 804 (lisp-indent-line)) 805 (compilation-next-error n))) 806 807 (defun geiser-repl--previous-error (n) 808 "Go to previous error in the REPL buffer." 809 (interactive "p") 810 (compilation-next-error (- n))) 811 812 (defun geiser-repl-clear-buffer () 813 "Delete the output generated by the scheme process." 814 (interactive) 815 (let ((inhibit-read-only t)) 816 (delete-region (point-min) (geiser-repl--last-prompt-start)) 817 (when (< (point) (geiser-repl--last-prompt-end)) 818 (goto-char (geiser-repl--last-prompt-end))) 819 (recenter t))) 820 821 (defvar geiser-repl-mode-map 822 (let ((map (make-sparse-keymap))) 823 (set-keymap-parent map comint-mode-map) 824 825 (define-key map "\C-d" 'delete-char) 826 (define-key map "\C-m" 'geiser-repl--maybe-send) 827 (define-key map [return] 'geiser-repl--maybe-send) 828 (define-key map "\C-j" 'geiser-repl--newline-and-indent) 829 (define-key map (kbd "TAB") 'geiser-repl-tab-dwim) 830 (define-key map [backtab] 'geiser-repl--previous-error) 831 832 (define-key map "\C-a" 'geiser-repl--bol) 833 (define-key map (kbd "<home>") 'geiser-repl--bol) 834 835 (geiser-menu--defmenu repl map 836 ("Complete symbol" ((kbd "M-TAB")) 837 completion-at-point :enable (geiser--symbol-at-point)) 838 ("Complete module name" ((kbd "C-.") (kbd "M-`")) 839 geiser-completion--complete-module :enable (geiser--symbol-at-point)) 840 ("Edit symbol" "\M-." geiser-edit-symbol-at-point 841 :enable (geiser--symbol-at-point)) 842 -- 843 ("Load scheme file..." "\C-c\C-l" geiser-load-file) 844 ("Switch to module..." "\C-c\C-m" switch-to-geiser-module) 845 ("Import module..." "\C-c\C-i" geiser-repl-import-module) 846 ("Add to load path..." "\C-c\C-r" geiser-add-to-load-path) 847 -- 848 ("Previous matching input" "\M-p" comint-previous-matching-input-from-input 849 "Previous input matching current") 850 ("Next matching input" "\M-n" comint-next-matching-input-from-input 851 "Next input matching current") 852 ("Previous prompt" "\C-c\C-p" geiser-repl-previous-prompt) 853 ("Next prompt" "\C-c\C-n" geiser-repl-next-prompt) 854 ("Previous input" "\C-c\M-p" comint-previous-input) 855 ("Next input" "\C-c\M-n" comint-next-input) 856 -- 857 ("Interrupt evaluation" ("\C-c\C-k" "\C-c\C-c") 858 geiser-repl-interrupt) 859 -- 860 (mode "Autodoc mode" ("\C-c\C-da" "\C-c\C-d\C-a") geiser-autodoc-mode) 861 ("Symbol documentation" ("\C-c\C-dd" "\C-c\C-d\C-d") 862 geiser-doc-symbol-at-point 863 "Documentation for symbol at point" :enable (geiser--symbol-at-point)) 864 ("Lookup symbol in manual" ("\C-c\C-di" "\C-c\C-d\C-i") 865 geiser-doc-look-up-manual 866 "Documentation for symbol at point" :enable (geiser--symbol-at-point)) 867 ("Module documentation" ("\C-c\C-dm" "\C-c\C-d\C-m") geiser-repl--doc-module 868 "Documentation for module at point" :enable (geiser--symbol-at-point)) 869 -- 870 ("Clear buffer" "\C-c\M-o" geiser-repl-clear-buffer 871 "Clean up REPL buffer, leaving just a lonely prompt") 872 ("Toggle ()/[]" ("\C-c\C-e\C-[" "\C-c\C-e[") geiser-squarify) 873 ("Insert λ" ("\C-c\\" "\C-c\C-\\") geiser-insert-lambda) 874 -- 875 ("Kill Scheme interpreter" "\C-c\C-q" geiser-repl-exit 876 :enable (geiser-repl--live-p)) 877 ("Restart" "\C-c\C-z" switch-to-geiser :enable (not (geiser-repl--live-p))) 878 879 -- 880 (custom "REPL options" geiser-repl)) 881 882 (define-key map [menu-bar completion] 'undefined) 883 map)) 884 885 (define-derived-mode geiser-repl-mode comint-mode "REPL" 886 "Major mode for interacting with an inferior scheme repl process. 887 \\{geiser-repl-mode-map}" 888 (scheme-mode-variables) 889 (set (make-local-variable 'geiser-repl--last-output-start) (point-marker)) 890 (set (make-local-variable 'geiser-repl--last-output-end) (point-marker)) 891 (set (make-local-variable 'face-remapping-alist) 892 '((comint-highlight-prompt geiser-font-lock-repl-prompt) 893 (comint-highlight-input geiser-font-lock-repl-input))) 894 (set (make-local-variable 'mode-line-process) nil) 895 (set (make-local-variable 'comint-use-prompt-regexp) nil) 896 (set (make-local-variable 'comint-prompt-read-only) 897 geiser-repl-read-only-prompt-p) 898 (setq comint-process-echoes nil) 899 (set (make-local-variable 'beginning-of-defun-function) 900 'geiser-repl--beginning-of-defun) 901 (set (make-local-variable 'comint-input-ignoredups) 902 geiser-repl-history-no-dups-p) 903 (setq geiser-eval--get-module-function 'geiser-repl--module-function) 904 (geiser-completion--setup t) 905 (setq geiser-smart-tab-mode-string "") 906 (geiser-smart-tab-mode t) 907 908 (setq-local font-lock-fontify-region-function 909 #'geiser-repl--wrap-fontify-region-function) 910 (setq-local font-lock-unfontify-region-function 911 #'geiser-repl--wrap-unfontify-region-function) 912 913 ;; enabling compilation-shell-minor-mode without the annoying highlighter 914 (compilation-setup t)) 915 916 917 ;;; User commands 918 919 (defun run-geiser (impl) 920 "Start a new Geiser REPL." 921 (interactive 922 (list (geiser-repl--get-impl "Start Geiser for scheme implementation: "))) 923 (geiser-repl--start-repl impl nil)) 924 925 (defalias 'geiser 'run-geiser) 926 927 (defun geiser-connect (impl &optional host port) 928 "Start a new Geiser REPL connected to a remote Scheme process." 929 (interactive 930 (list (geiser-repl--get-impl "Connect to Scheme implementation: "))) 931 (geiser-repl--start-repl impl (geiser-repl--read-address host port))) 932 933 (defun geiser-connect-local (impl socket) 934 "Start a new Geiser REPL connected to a remote Scheme process 935 over a Unix-domain socket." 936 (interactive 937 (list (geiser-repl--get-impl "Connect to Scheme implementation: ") 938 (expand-file-name (read-file-name "Socket file name: ")))) 939 (geiser-repl--start-repl impl socket)) 940 941 (defvar-local geiser-repl--last-scm-buffer nil) 942 943 (defun geiser-repl--maybe-remember-scm-buffer (buffer) 944 (when (and buffer 945 (eq 'scheme-mode (with-current-buffer buffer major-mode)) 946 (eq major-mode 'geiser-repl-mode)) 947 (setq geiser-repl--last-scm-buffer buffer))) 948 949 (defvar-local geiser-repl--binary nil) 950 951 (defvar-local geiser-repl--arglist nil) 952 953 (defun geiser-repl--get-binary (impl) 954 (or geiser-repl--binary (geiser-repl--binary impl))) 955 956 (defun geiser-repl--get-arglist (impl) 957 (or geiser-repl--arglist (geiser-repl--arglist impl))) 958 959 (defun switch-to-geiser (&optional ask impl buffer) 960 "Switch to running Geiser REPL. 961 962 If REPL is the current buffer, switch to the previously used 963 scheme buffer. 964 965 With prefix argument, ask for which one if more than one is running. 966 If no REPL is running, execute `run-geiser' to start a fresh one." 967 (interactive "P") 968 (let* ((impl (or impl geiser-impl--implementation)) 969 (in-repl (eq major-mode 'geiser-repl-mode)) 970 (in-live-repl (and in-repl (get-buffer-process (current-buffer)))) 971 (repl (unless ask 972 (if impl 973 (geiser-repl--repl/impl impl) 974 (or geiser-repl--repl (car geiser-repl--repls)))))) 975 (cond (in-live-repl 976 (when (and (not (eq repl buffer)) 977 (buffer-live-p geiser-repl--last-scm-buffer)) 978 (geiser-repl--switch-to-buffer geiser-repl--last-scm-buffer))) 979 (repl (geiser-repl--switch-to-buffer repl)) 980 ((geiser-repl--remote-p) 981 (geiser-connect impl (geiser-repl--host) (geiser-repl--port))) 982 ((geiser-repl--local-p) 983 (geiser-connect-local impl geiser-repl--address)) 984 (impl (run-geiser impl)) 985 (t (call-interactively 'run-geiser))) 986 (geiser-repl--maybe-remember-scm-buffer buffer))) 987 988 (defun switch-to-geiser-module (&optional module buffer) 989 "Switch to running Geiser REPL and try to enter a given module." 990 (interactive) 991 (let* ((module (or module 992 (geiser-completion--read-module 993 "Switch to module (default top-level): "))) 994 (cmd (and module 995 (geiser-repl--enter-cmd geiser-impl--implementation 996 module)))) 997 (unless (eq major-mode 'geiser-repl-mode) 998 (switch-to-geiser nil nil (or buffer (current-buffer)))) 999 (geiser-repl--send cmd))) 1000 1001 (defun geiser-repl-import-module (&optional module) 1002 "Import a given module in the current namespace of the REPL." 1003 (interactive) 1004 (let* ((module (or module 1005 (geiser-completion--read-module "Import module: "))) 1006 (cmd (and module 1007 (geiser-repl--import-cmd geiser-impl--implementation 1008 module)))) 1009 (switch-to-geiser nil nil (current-buffer)) 1010 (geiser-repl--send cmd))) 1011 1012 (defun geiser-repl-exit (&optional arg) 1013 "Exit the current REPL. 1014 With a prefix argument, force exit by killing the scheme process." 1015 (interactive "P") 1016 (when (or (not geiser-repl-query-on-exit-p) 1017 (y-or-n-p "Really quit this REPL? ")) 1018 (geiser-con--connection-deactivate geiser-repl--connection t) 1019 (let ((cmd (and (not arg) 1020 (geiser-repl--exit-cmd geiser-impl--implementation)))) 1021 (if cmd 1022 (when (stringp cmd) (geiser-repl--send cmd)) 1023 (comint-kill-subjob))))) 1024 1025 (defun geiser-repl-next-prompt (n) 1026 (interactive "p") 1027 (when (> n 0) 1028 (end-of-line) 1029 (re-search-forward comint-prompt-regexp nil 'go n))) 1030 1031 (defun geiser-repl-previous-prompt (n) 1032 (interactive "p") 1033 (when (> n 0) 1034 (end-of-line 0) 1035 (when (re-search-backward comint-prompt-regexp nil 'go n) 1036 (goto-char (match-end 0))))) 1037 1038 1039 ;;; Unload: 1040 1041 (defun geiser-repl--repl-list () 1042 (let (lst) 1043 (dolist (repl geiser-repl--repls lst) 1044 (when (buffer-live-p repl) 1045 (with-current-buffer repl 1046 (push (cons geiser-impl--implementation 1047 geiser-repl--address) 1048 lst)))))) 1049 1050 (defun geiser-repl--restore (impls) 1051 (dolist (impl impls) 1052 (when impl 1053 (condition-case err 1054 (geiser-repl--start-repl (car impl) (cdr impl)) 1055 (error (message (error-message-string err))))))) 1056 1057 (defun geiser-repl-unload-function () 1058 (dolist (repl geiser-repl--repls) 1059 (when (buffer-live-p repl) 1060 (with-current-buffer repl 1061 (let ((geiser-repl-query-on-exit-p nil)) (geiser-repl-exit)) 1062 (sit-for 0.05) 1063 (kill-buffer))))) 1064 1065 1066 (provide 'geiser-repl) 1067 1068 1069 ;;; Initialization: 1070 ;; After providing 'geiser-repl, so that impls can use us. 1071 (mapc 'geiser-impl--load-impl geiser-active-implementations)