elisp/geiser-mode.el

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