elisp/geiser-mode.el

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