geiser-mode.el (15729B)
1 ;;; geiser-mode.el -- minor mode for scheme buffers -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2009-2017, 2020, 2022 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 ;; Start date: Sun Feb 08, 2009 15:13 11 12 13 ;;; Code: 14 15 (require 'geiser-repl) 16 (require 'geiser-capf) 17 (require 'geiser-menu) 18 (require 'geiser-doc) 19 (require 'geiser-compile) 20 (require 'geiser-completion) 21 (require 'geiser-xref) 22 (require 'geiser-edit) 23 (require 'geiser-autodoc) 24 (require 'geiser-debug) 25 (require 'geiser-syntax) 26 (require 'geiser-impl) 27 (require 'geiser-eval) 28 (require 'geiser-popup) 29 (require 'geiser-custom) 30 (require 'geiser-base) 31 32 33 ;;; Customization: 34 35 (defgroup geiser-mode nil 36 "Mode enabling Geiser abilities in Scheme buffers &co.." 37 :group 'geiser) 38 39 (geiser-custom--defcustom geiser-mode-auto-p t 40 "Whether `geiser-mode' should be active by default in all scheme buffers." 41 :group 'geiser-mode 42 :type 'boolean) 43 44 (geiser-custom--defcustom geiser-mode-start-repl-p nil 45 "Whether a REPL should be automatically started if one is not 46 active when `geiser-mode' is activated in a buffer." 47 :group 'geiser-mode 48 :type 'boolean) 49 50 (geiser-custom--defcustom geiser-mode-autodoc-p t 51 "Whether `geiser-autodoc-mode' gets enabled by default in Scheme buffers." 52 :group 'geiser-mode 53 :group 'geiser-autodoc 54 :type 'boolean) 55 56 (geiser-custom--defcustom geiser-mode-smart-tab-p nil 57 "Whether `geiser-smart-tab-mode' gets enabled by default in Scheme buffers." 58 :group 'geiser-mode 59 :type 'boolean) 60 61 (geiser-custom--defcustom geiser-mode-eval-last-sexp-to-buffer nil 62 "Whether `eval-last-sexp' prints results to buffer" 63 :group 'geiser-mode 64 :type 'boolean) 65 66 (geiser-custom--defcustom geiser-mode-eval-to-buffer-prefix " " 67 "When `geiser-mode-eval-last-sexp-to-buffer', the prefix string 68 which will be prepended to results." 69 :group 'geiser-mode 70 :type 'string) 71 72 (geiser-custom--defcustom geiser-mode-eval-to-buffer-transformer nil 73 "Transformer for results inserted in debug buffer. 74 75 When `geiser-mode-eval-last-sexp-to-buffer', the result will be 76 transformed using this function default behavior is just prepend 77 with `geiser-mode-eval-to-buffer-prefix' takes two arguments: 78 `msg' and `is-error?' `msg' is the result string going to be 79 transformed, `is-error?' is a boolean indicating whether the 80 result is an error msg." 81 :group 'geiser-mode 82 :type 'function) 83 84 85 86 ;;; Evaluation commands: 87 88 (defun geiser--go-to-repl () 89 (geiser-repl--switch-to-repl) 90 (push-mark) 91 (goto-char (point-max))) 92 93 (defun geiser-wait-eval (req timeout) 94 "Use REQ, the result of computing an evaluation, to wait for its result. 95 96 TIMEOUT is the number of seconds to wait for evaluation 97 completion. Functions returning a waitable REQ are 98 `geiser-eval-region' and its derivatives evaluating buffers or 99 individual sexps." 100 (geiser-eval--wait req (* 1000 timeout))) 101 102 (defun geiser-eval-region (start end &optional and-go raw nomsg) 103 "Eval the current region in the Geiser REPL. 104 105 With prefix, goes to the REPL buffer afterwards (as 106 `geiser-eval-region-and-go'). The evaluation is performed 107 asynchronously: this function's return value can be used to wait 108 for its completion using `geiser-eval-wait'. See also 109 `geiser-eval-region/wait' if you just need to eval a region 110 programmatically in a synchronous way." 111 (interactive "rP") 112 (save-restriction 113 (narrow-to-region start end) 114 (check-parens)) 115 (geiser-debug--send-region nil 116 start 117 end 118 (and and-go 'geiser--go-to-repl) 119 (not raw) 120 nomsg)) 121 122 (defun geiser-eval-region/wait (start end &optional timeout) 123 "Like `geiser-eval-region', but waiting for the evaluation to finish. 124 Returns its raw result, rather than displaying it. TIMEOUT is the 125 number of seconds to wait for the evaluation to finish." 126 (geiser-debug--send-region/wait nil start end (* 1000 (or timeout 10)))) 127 128 (defun geiser-eval-region-and-go (start end) 129 "Eval the current region in the Geiser REPL and visit it afterwads." 130 (interactive "r") 131 (geiser-eval-region start end t)) 132 133 (geiser-impl--define-caller geiser-eval--bounds eval-bounds () 134 "A pair with the bounds of a buffer to be evaluated, defaulting 135 to (cons (point-min) . (point-max)).") 136 137 (defun geiser-eval-buffer (&optional and-go raw nomsg) 138 "Eval the current buffer in the Geiser REPL. 139 140 With prefix, goes to the REPL buffer afterwards (as 141 `geiser-eval-buffer-and-go')" 142 (interactive "P") 143 (let* ((bounds (geiser-eval--bounds geiser-impl--implementation)) 144 (from (or (car bounds) (point-min))) 145 (to (or (cdr bounds) (point-max)))) 146 (geiser-eval-region from to and-go raw nomsg))) 147 148 (defun geiser-eval-buffer-and-go () 149 "Eval the current buffer in the Geiser REPL and visit it afterwads." 150 (interactive) 151 (geiser-eval-buffer t)) 152 153 (defun geiser-eval-definition (&optional and-go) 154 "Eval the current definition in the Geiser REPL. 155 156 With prefix, goes to the REPL buffer afterwards (as 157 `geiser-eval-definition-and-go')" 158 (interactive "P") 159 (save-excursion 160 (end-of-defun) 161 (let ((end (point))) 162 (beginning-of-defun) 163 (geiser-eval-region (point) end and-go t)))) 164 165 (defun geiser-eval-definition-and-go () 166 "Eval the current definition in the Geiser REPL and visit it afterwads." 167 (interactive) 168 (geiser-eval-definition t)) 169 170 (defun geiser-eval-last-sexp (print-to-buffer-p) 171 "Eval the previous sexp in the Geiser REPL. 172 173 With a prefix, revert the effect of `geiser-mode-eval-last-sexp-to-buffer' " 174 (interactive "P") 175 (let* (bosexp 176 (eosexp (save-excursion (backward-sexp) 177 (setq bosexp (point)) 178 (forward-sexp) 179 (point))) 180 (ret-transformer (or geiser-mode-eval-to-buffer-transformer 181 (lambda (msg is-error?) 182 (format "%s%s%s" 183 geiser-mode-eval-to-buffer-prefix 184 (if is-error? "ERROR" "") 185 msg)))) 186 (ret (save-excursion 187 (geiser-eval-region bosexp ;beginning of sexp 188 eosexp ;end of sexp 189 nil 190 t 191 print-to-buffer-p))) 192 (ret (geiser-wait-eval ret 30)) 193 (err (geiser-eval--retort-error ret)) 194 (will-eval-to-buffer (if print-to-buffer-p 195 (not geiser-mode-eval-last-sexp-to-buffer) 196 geiser-mode-eval-last-sexp-to-buffer)) 197 (str (geiser-eval--retort-result-str ret 198 (when will-eval-to-buffer "")))) 199 (cond ((not will-eval-to-buffer) str) 200 (err (insert (funcall ret-transformer 201 (geiser-eval--error-str err) t))) 202 ((string= "" str)) 203 (t (push-mark) 204 (insert (funcall ret-transformer str nil)))))) 205 206 (defun geiser-compile-definition (&optional and-go) 207 "Compile the current definition in the Geiser REPL. 208 209 With prefix, goes to the REPL buffer afterwards (as 210 `geiser-eval-definition-and-go')" 211 (interactive "P") 212 (save-excursion 213 (end-of-defun) 214 (let ((end (point))) 215 (beginning-of-defun) 216 (geiser-debug--send-region t 217 (point) 218 end 219 (and and-go 'geiser--go-to-repl) 220 t)))) 221 222 (defun geiser-compile-definition-and-go () 223 "Compile the current definition in the Geiser REPL and visit it afterwads." 224 (interactive) 225 (geiser-compile-definition t)) 226 227 (defun geiser-expand-region (start end &optional all raw) 228 "Macro-expand the current region and display it in a buffer. 229 With prefix, recursively macro-expand the resulting expression." 230 (interactive "rP") 231 (geiser-debug--expand-region start end all (not raw))) 232 233 (defun geiser-expand-definition (&optional all) 234 "Macro-expand the current definition. 235 236 With prefix, recursively macro-expand the resulting expression." 237 (interactive "P") 238 (save-excursion 239 (end-of-defun) 240 (let ((end (point))) 241 (beginning-of-defun) 242 (geiser-expand-region (point) end all t)))) 243 244 (defun geiser-expand-last-sexp (&optional all) 245 "Macro-expand the previous sexp. 246 247 With prefix, recursively macro-expand the resulting expression." 248 (interactive "P") 249 (geiser-expand-region (save-excursion (backward-sexp) (point)) 250 (point) 251 all 252 t)) 253 254 (defun geiser-set-scheme () 255 "Associates current buffer with a given Scheme implementation." 256 (interactive) 257 (save-excursion 258 (geiser-syntax--remove-kws) 259 (let ((impl (geiser-impl--read-impl))) 260 (geiser-impl--set-buffer-implementation impl) 261 (geiser-repl--set-up-repl impl) 262 (geiser-syntax--add-kws) 263 (geiser-syntax--fontify)))) 264 265 (defun geiser-mode-switch-to-repl (arg) 266 "Switches to Geiser REPL. 267 268 With prefix, try to enter the current buffer's module." 269 (interactive "P") 270 (geiser-repl--switch-to-repl arg)) 271 272 (defun geiser-mode-switch-to-repl-and-enter () 273 "Switches to Geiser REPL and enters current buffer's module." 274 (interactive) 275 (geiser-mode-switch-to-repl t)) 276 277 (defun geiser-restart-repl () 278 "Restarts the REPL associated with the current buffer." 279 (interactive) 280 (let ((b (current-buffer)) 281 (impl geiser-impl--implementation)) 282 (when (buffer-live-p geiser-repl--repl) 283 (geiser-mode-switch-to-repl nil) 284 (comint-kill-subjob) 285 (sit-for 0.1)) ;; ugly hack; but i don't care enough to fix it 286 (geiser impl) 287 (sit-for 0.2) 288 (goto-char (point-max)) 289 (pop-to-buffer b))) 290 291 (defun geiser-exit-repl () 292 "Issues the command `geiser-repl-exit' in this buffer's associated REPL." 293 (interactive) 294 (geiser-repl--call-in-repl #'geiser-repl-exit)) 295 296 297 ;;; Keys: 298 299 (defvar geiser-mode-map 300 (let ((map (make-sparse-keymap))) 301 (define-key map [menu-bar scheme] 'undefined) 302 ;; (geiser-mode--triple-chord ?x ?m 'geiser-xref-generic-methods) 303 304 (geiser-menu--defmenu geiserm map 305 ("Eval sexp before point" "\C-x\C-e" geiser-eval-last-sexp) 306 ("Eval definition" ("\M-\C-x" "\C-c\C-c") geiser-eval-definition) 307 ("Eval definition and go" ("\C-c\M-e" "\C-c\M-e") 308 geiser-eval-definition-and-go) 309 ("Eval region" "\C-c\C-r" geiser-eval-region :enable mark-active) 310 ("Eval region and go" "\C-c\M-r" geiser-eval-region-and-go 311 geiser-eval-region :enable mark-active) 312 ("Eval buffer" "\C-c\C-b" geiser-eval-buffer) 313 ("Eval buffer and go" "\C-c\M-b" geiser-eval-buffer-and-go) 314 ("Load scheme file..." "\C-c\C-l" geiser-load-file) 315 ("Abort evaluation" ("\C-c\C-i" "\C-c\C-e\C-i" "\C-c\C-ei") 316 geiser-eval-interrupt) 317 (menu "Macroexpand" 318 ("Sexp before point" ("\C-c\C-m\C-e" "\C-c\C-me") 319 geiser-expand-last-sexp) 320 ("Region" ("\C-c\C-m\C-r" "\C-c\C-mr") geiser-expand-region) 321 ("Definition" ("\C-c\C-m\C-x" "\C-c\C-mx") geiser-expand-definition)) 322 -- 323 ("Symbol documentation" ("\C-c\C-d\C-d" "\C-c\C-dd") 324 geiser-doc-symbol-at-point :enable (geiser--symbol-at-point)) 325 ("Short symbol documentation" ("\C-c\C-d\C-s" "\C-c\C-ds") 326 geiser-autodoc-show :enable (geiser--symbol-at-point)) 327 ("Module documentation" ("\C-c\C-d\C-m" "\C-c\C-dm") geiser-doc-module) 328 ("Symbol manual lookup" ("\C-c\C-d\C-i" "\C-c\C-di") 329 geiser-doc-look-up-manual :enable (geiser-doc--manual-available-p)) 330 (mode "Autodoc mode" ("\C-c\C-d\C-a" "\C-c\C-da") geiser-autodoc-mode) 331 -- 332 ("Compile buffer" "\C-c\C-k" geiser-compile-current-buffer) 333 ("Switch to REPL" "\C-c\C-z" geiser-mode-switch-to-repl) 334 ("Switch to REPL and enter module" "\C-c\C-a" 335 geiser-mode-switch-to-repl-and-enter) 336 ("Set Scheme..." "\C-c\C-s" geiser-set-scheme) 337 ("Exit REPL or debugger" "\C-c\C-q" geiser-exit-repl) 338 -- 339 ("Edit symbol at point" "\M-." geiser-edit-symbol-at-point 340 :enable (geiser--symbol-at-point)) 341 ("Go to previous definition" "\M-," geiser-pop-symbol-stack) 342 ("Complete symbol" ((kbd "M-TAB")) completion-at-point 343 :enable (geiser--symbol-at-point)) 344 ("Complete module name" ((kbd "M-`") (kbd "C-.")) 345 geiser-capf-complete-module) 346 ("Edit module" ("\C-c\C-e\C-m" "\C-c\C-em") geiser-edit-module) 347 ("Add to load path..." ("\C-c\C-e\C-l" "\C-c\C-el") geiser-add-to-load-path) 348 ("Toggle ()/[]" ("\C-c\C-e\C-[" "\C-c\C-e[") geiser-squarify) 349 ("Insert λ" ("\C-c\\" "\C-c\C-\\") geiser-insert-lambda) 350 -- 351 ("Callers" ((kbd "C-c <")) geiser-xref-callers 352 :enable (and (geiser-eval--supported-p 'callers) 353 (geiser--symbol-at-point))) 354 ("Callees" ((kbd "C-c >")) geiser-xref-callees 355 :enable (and (geiser-eval--supported-p 'callees) 356 (geiser--symbol-at-point))) 357 -- 358 (mode "Smart TAB mode" nil geiser-smart-tab-mode) 359 -- 360 (custom "Customize Geiser mode" geiser-mode)) 361 map)) 362 363 364 ;;; Geiser mode: 365 366 (defvar-local geiser-mode-string nil 367 "Modeline indicator for geiser-mode") 368 369 (defun geiser-mode--lighter () 370 (or geiser-mode-string 371 (format " %s" (or (geiser-impl--impl-str) "G")))) 372 373 (define-minor-mode geiser-mode 374 "Toggle Geiser's mode. 375 376 With no argument, this command toggles the mode. 377 Non-null prefix argument turns on the mode. 378 Null prefix argument turns off the mode. 379 380 When Geiser mode is enabled, a host of nice utilities for 381 interacting with the Geiser REPL is at your disposal. 382 \\{geiser-mode-map}" 383 :init-value nil 384 :lighter (:eval (geiser-mode--lighter)) 385 :group 'geiser-mode 386 (when geiser-mode (geiser-impl--set-buffer-implementation nil t)) 387 (setq geiser-autodoc-mode-string "/A") 388 (setq geiser-smart-tab-mode-string "/T") 389 (geiser-capf-setup geiser-mode) 390 (when geiser-mode-autodoc-p 391 (geiser-autodoc-mode (if geiser-mode 1 -1))) 392 (when geiser-mode-smart-tab-p 393 (geiser-smart-tab-mode (if geiser-mode 1 -1))) 394 (geiser-syntax--add-kws) 395 (when (and geiser-mode 396 geiser-mode-start-repl-p 397 (not (geiser-syntax--font-lock-buffer-p)) 398 (not (geiser-repl--connection*))) 399 (save-window-excursion (geiser geiser-impl--implementation)))) 400 401 (defun turn-on-geiser-mode () 402 "Enable `geiser-mode' (in a Scheme buffer)." 403 (interactive) 404 (geiser-mode 1)) 405 406 (defun turn-off-geiser-mode () 407 "Disable `geiser-mode' (in a Scheme buffer)." 408 (interactive) 409 (geiser-mode -1)) 410 411 (defun geiser-mode--maybe-activate () 412 (when (and geiser-mode-auto-p (eq major-mode 'scheme-mode)) 413 (turn-on-geiser-mode))) 414 415 416 ;;; Reload support: 417 418 (defun geiser-mode--buffers () 419 (let ((buffers)) 420 (dolist (buffer (buffer-list)) 421 (when (buffer-live-p buffer) 422 (set-buffer buffer) 423 (when geiser-mode 424 (push (cons buffer geiser-impl--implementation) buffers)))) 425 buffers)) 426 427 (defun geiser-mode--restore (buffers) 428 (dolist (b buffers) 429 (when (buffer-live-p (car b)) 430 (set-buffer (car b)) 431 (when (cdr b) 432 (geiser-impl--set-buffer-implementation (cdr b))) 433 (geiser-mode 1)))) 434 435 (defun geiser-mode-unload-function () 436 (dolist (b (geiser-mode--buffers)) 437 (with-current-buffer (car b) (geiser-mode nil)))) 438 439 440 (provide 'geiser-mode)