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