elisp/geiser-mode.el

   1 ;; geiser-mode.el -- minor mode for scheme buffers
   2
   3 ;; Copyright (C) 2009, 2010 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-autodoc-p t
  45   "Whether `geiser-autodoc-mode' gets enabled by default in Scheme buffers."
  46   :group 'geiser-mode
  47   :group 'geiser-autodoc
  48   :type 'boolean)
  49
  50 (geiser-custom--defcustom geiser-mode-company-p t
  51   "Whether to use company-mode for completion, if available."
  52   :group 'geiser-mode
  53   :type 'boolean)
  54
  55 (geiser-custom--defcustom geiser-mode-smart-tab-p nil
  56   "Whether `geiser-smart-tab-mode' gets enabled by default in Scheme buffers."
  57   :group 'geiser-mode
  58   :type 'boolean)
  59
  60
  61 \f
  62 ;;; Evaluation commands:
  63
  64 (defun geiser--go-to-repl ()
  65   (switch-to-geiser nil nil (current-buffer))
  66   (push-mark)
  67   (goto-char (point-max)))
  68
  69 (defun geiser-eval-region (start end &optional and-go raw)
  70   "Eval the current region in the Geiser REPL.
  71 With prefix, goes to the REPL buffer afterwards (as
  72 `geiser-eval-region-and-go')"
  73   (interactive "rP")
  74   (geiser-debug--send-region nil
  75                              start
  76                              end
  77                              (and and-go 'geiser--go-to-repl)
  78                              (not raw)))
  79
  80 (defun geiser-eval-region-and-go (start end)
  81   "Eval the current region in the Geiser REPL and visit it afterwads."
  82   (interactive "r")
  83   (geiser-eval-region start end t))
  84
  85 (defun geiser-eval-definition (&optional and-go)
  86   "Eval the current definition in the Geiser REPL.
  87 With prefix, goes to the REPL buffer afterwards (as
  88 `geiser-eval-definition-and-go')"
  89   (interactive "P")
  90   (save-excursion
  91     (end-of-defun)
  92     (let ((end (point)))
  93       (beginning-of-defun)
  94       (geiser-eval-region (point) end and-go t))))
  95
  96 (defun geiser-eval-definition-and-go ()
  97   "Eval the current definition in the Geiser REPL and visit it afterwads."
  98   (interactive)
  99   (geiser-eval-definition t))
 100
 101 (defun geiser-eval-last-sexp ()
 102   "Eval the previous sexp in the Geiser REPL."
 103   (interactive)
 104   (geiser-eval-region (save-excursion (backward-sexp) (point))
 105                       (point)
 106                       nil
 107                       t))
 108
 109 (defun geiser-compile-definition (&optional and-go)
 110   "Compile the current definition in the Geiser REPL.
 111 With prefix, goes to the REPL buffer afterwards (as
 112 `geiser-eval-definition-and-go')"
 113   (interactive "P")
 114   (save-excursion
 115     (end-of-defun)
 116     (let ((end (point)))
 117       (beginning-of-defun)
 118       (geiser-debug--send-region t
 119                                  (point)
 120                                  end
 121                                  (and and-go 'geiser--go-to-repl)
 122                                  t))))
 123
 124 (defun geiser-compile-definition-and-go ()
 125   "Compile the current definition in the Geiser REPL and visit it afterwads."
 126   (interactive)
 127   (geiser-compile-definition t))
 128
 129 (defun geiser-expand-region (start end &optional all raw)
 130   "Macro-expand the current region and display it in a buffer.
 131 With prefix, recursively macro-expand the resulting expression."
 132   (interactive "rP")
 133   (geiser-debug--expand-region start end all (not raw)))
 134
 135 (defun geiser-expand-definition (&optional all)
 136   "Macro-expand the current definition.
 137 With prefix, recursively macro-expand the resulting expression."
 138   (interactive "P")
 139   (save-excursion
 140     (end-of-defun)
 141     (let ((end (point)))
 142       (beginning-of-defun)
 143       (geiser-expand-region (point) end all t))))
 144
 145 (defun geiser-expand-last-sexp (&optional all)
 146   "Macro-expand the previous sexp.
 147 With prefix, recursively macro-expand the resulting expression."
 148   (interactive "P")
 149   (geiser-expand-region (save-excursion (backward-sexp) (point))
 150                         (point)
 151                         all
 152                         t))
 153
 154 (defun geiser-set-scheme ()
 155   "Associates current buffer with a given Scheme implementation."
 156   (interactive)
 157   (let ((impl (geiser-impl--read-impl)))
 158     (geiser-impl--set-buffer-implementation impl)
 159     (geiser-repl--set-up-repl impl)))
 160
 161 (defun geiser-mode-switch-to-repl (arg)
 162   "Switches to Geiser REPL.
 163 With prefix, try to enter the current's buffer module."
 164   (interactive "P")
 165   (if arg
 166       (switch-to-geiser-module (geiser-eval--get-module) (current-buffer))
 167     (switch-to-geiser nil nil (current-buffer))))
 168
 169 (defun geiser-mode-switch-to-repl-and-enter ()
 170   "Switches to Geiser REPL and enters current's buffer module."
 171   (interactive)
 172   (geiser-mode-switch-to-repl t))
 173
 174 (defun geiser-restart-repl ()
 175   "Restarts the REPL associated with the current buffer."
 176   (interactive)
 177   (let ((b (current-buffer)))
 178     (geiser-mode-switch-to-repl nil)
 179     (comint-kill-subjob)
 180     (sit-for 0.1) ;; ugly hack; but i don't care enough to fix it
 181     (call-interactively 'run-geiser)
 182     (sit-for 0.2) ;; ditto
 183     (goto-char (point-max))
 184     (pop-to-buffer b)))
 185
 186 (defun geiser-squarify (n)
 187   "Toggle between () and [] for current form.
 188 With numeric prefix, perform that many toggles, forward for
 189 positive values and backward for negative."
 190   (interactive "p")
 191   (let ((pared (and (boundp 'paredit-mode) paredit-mode))
 192         (fwd (> n 0))
 193         (steps (abs n)))
 194     (when (and pared (fboundp 'paredit-mode)) (paredit-mode -1))
 195     (unwind-protect
 196         (save-excursion
 197           (unless (looking-at-p "\\s(") (backward-up-list))
 198           (while (> steps 0)
 199             (let ((p (point))
 200                   (round (looking-at-p "(")))
 201               (forward-sexp)
 202               (backward-delete-char 1)
 203               (insert (if round "]" ")"))
 204               (goto-char p)
 205               (delete-char 1)
 206               (insert (if round "[" "("))
 207               (setq steps (1- steps))
 208               (backward-char)
 209               (condition-case nil
 210                   (progn (when fwd (forward-sexp 2))
 211                          (backward-sexp))
 212                 (error (setq steps 0))))))
 213       (when (and pared (fboundp 'paredit-mode)) (paredit-mode 1)))))
 214
 215 \f
 216 ;;; Geiser mode:
 217
 218 (make-variable-buffer-local
 219  (defvar geiser-mode-string nil
 220    "Modeline indicator for geiser-mode"))
 221
 222 (defun geiser-mode--lighter ()
 223   (or geiser-mode-string
 224       (format " %s" (or (geiser-impl--impl-str) "G"))))
 225
 226 (defvar geiser-mode-map (make-sparse-keymap))
 227
 228 (define-minor-mode geiser-mode
 229   "Toggle Geiser's mode.
 230 With no argument, this command toggles the mode.
 231 Non-null prefix argument turns on the mode.
 232 Null prefix argument turns off the mode.
 233
 234 When Geiser mode is enabled, a host of nice utilities for
 235 interacting with the Geiser REPL is at your disposal.
 236 \\{geiser-mode-map}"
 237   :init-value nil
 238   :lighter (:eval (geiser-mode--lighter))
 239   :group 'geiser-mode
 240   :keymap geiser-mode-map
 241   (when geiser-mode (geiser-impl--set-buffer-implementation nil t))
 242   (setq geiser-autodoc-mode-string "/A")
 243   (setq geiser-smart-tab-mode-string "/T")
 244   (geiser-company--setup (and geiser-mode geiser-mode-company-p))
 245   (when geiser-mode-autodoc-p
 246     (geiser-autodoc-mode (if geiser-mode 1 -1)))
 247   (when geiser-mode-smart-tab-p
 248     (geiser-smart-tab-mode (if geiser-mode 1 -1)))
 249   (geiser-syntax--add-kws))
 250
 251 (defun turn-on-geiser-mode ()
 252   "Enable `geiser-mode' (in a Scheme buffer)."
 253   (interactive)
 254   (geiser-mode 1))
 255
 256 (defun turn-off-geiser-mode ()
 257   "Disable `geiser-mode' (in a Scheme buffer)."
 258   (interactive)
 259   (geiser-mode -1))
 260
 261 (defun geiser-mode--maybe-activate ()
 262   (when geiser-mode-auto-p (turn-on-geiser-mode)))
 263
 264 \f
 265 ;;; Keys:
 266
 267 (geiser-menu--defmenu geiserm geiser-mode-map
 268   ("Eval sexp before point" "\C-x\C-e" geiser-eval-last-sexp)
 269   ("Eval definition" "\M-\C-x" geiser-eval-definition)
 270   ("Eval definition and go" "\C-c\M-e" geiser-eval-definition-and-go)
 271   ("Eval region" "\C-c\C-r" geiser-eval-region :enable mark-active)
 272   ("Eval region and go" "\C-c\M-r" geiser-eval-region-and-go
 273    geiser-eval-region :enable mark-active)
 274 ;;  ("Compile definition" "\C-c\M-c" geiser-compile-definition)
 275 ;;  ("Compile definition and go" "\C-c\C-c" geiser-compile-definition-and-go)
 276   (menu "Macroexpand"
 277         ("Sexp before point" ("\C-c\C-m\C-e" "\C-c\C-me")
 278          geiser-expand-last-sexp)
 279         ("Region" ("\C-c\C-m\C-r" "\C-c\C-mr") geiser-expand-region)
 280         ("Definition" ("\C-c\C-m\C-x" "\C-c\C-mx") geiser-expand-definition))
 281   --
 282   ("Symbol documentation" ("\C-c\C-d\C-d" "\C-c\C-dd")
 283    geiser-doc-symbol-at-point :enable (symbol-at-point))
 284   ("Module documentation" ("\C-c\C-d\C-m" "\C-c\C-dm") geiser-doc-module)
 285   ("Symbol manual lookup" ("\C-c\C-d\C-i" "\C-c\C-di")
 286    geiser-doc-look-up-manual :enable (geiser-doc--manual-available-p))
 287   (mode "Autodoc mode" ("\C-c\C-d\C-a" "\C-c\C-da") geiser-autodoc-mode)
 288   --
 289   ("Compile buffer" "\C-c\C-k" geiser-compile-current-buffer)
 290   ("Switch to REPL" "\C-c\C-z" geiser-mode-switch-to-repl)
 291   ("Switch to REPL and enter module" "\C-c\C-Z"
 292    geiser-mode-switch-to-repl-and-enter)
 293   ("Set Scheme..." "\C-c\C-s" geiser-set-scheme)
 294   --
 295   ("Edit symbol at point" "\M-." geiser-edit-symbol-at-point
 296    :enable (symbol-at-point))
 297   ("Go to previous definition" "\M-," geiser-pop-symbol-stack)
 298   ("Complete symbol" ((kbd "M-TAB")) geiser-completion--complete-symbol
 299    :enable (symbol-at-point))
 300   ("Complete module name" ((kbd "M-`") (kbd "C-."))
 301    geiser-completion--complete-module)
 302   ("Edit module" ("\C-c\C-e\C-m" "\C-c\C-em") geiser-edit-module)
 303   ("Toggle ()/[]" ("\C-c\C-e\C-[" "\C-c\C-e[") geiser-squarify)
 304   --
 305   ("Callers" ((kbd "C-c <")) geiser-xref-callers
 306    :enable (and (geiser-eval--supported-p 'callers) (symbol-at-point)))
 307   ("Callees" ((kbd "C-c >")) geiser-xref-callees
 308    :enable (and (geiser-eval--supported-p 'callees) (symbol-at-point)))
 309   --
 310   (mode "Smart TAB mode" nil geiser-smart-tab-mode)
 311   --
 312   (custom "Customize Geiser mode" geiser-mode))
 313
 314 (define-key geiser-mode-map [menu-bar scheme] 'undefined)
 315
 316 ;; (geiser-mode--triple-chord ?x ?m 'geiser-xref-generic-methods)
 317
 318 \f
 319 ;;; Reload support:
 320
 321 (defun geiser-mode--buffers ()
 322   (let ((buffers))
 323     (dolist (buffer (buffer-list))
 324       (when (buffer-live-p buffer)
 325         (set-buffer buffer)
 326         (when geiser-mode
 327           (push (cons buffer geiser-impl--implementation) buffers))))
 328     buffers))
 329
 330 (defun geiser-mode--restore (buffers)
 331   (dolist (b buffers)
 332     (when (buffer-live-p (car b))
 333       (set-buffer (car b))
 334       (when (cdr b)
 335         (geiser-impl--set-buffer-implementation (cdr b)))
 336       (geiser-mode 1))))
 337
 338 (defun geiser-mode-unload-function ()
 339   (dolist (b (geiser-mode--buffers))
 340     (with-current-buffer (car b) (geiser-mode nil))))
 341
 342 \f
 343 (provide 'geiser-mode)
 344 ;;; geiser-mode.el ends here