elisp/geiser-compile.el

   1 ;;; geiser-compile.el -- compile/load scheme files
   2
   3 ;; Copyright (C) 2009, 2010, 2011, 2012, 2013, 2016, 2018 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: Wed Feb 11, 2009 00:16
  11
  12 \f
  13 ;;; Code:
  14
  15 (require 'geiser-debug)
  16 (require 'geiser-autodoc)
  17 (require 'geiser-eval)
  18 (require 'geiser-base)
  19
  20 (declare-function geiser-restart-repl "geiser-mode" ())
  21
  22 \f
  23 ;;; Auxiliary functions:
  24
  25 (defun geiser-compile--buffer/path (&optional path)
  26   (let ((path (or path (read-file-name "Scheme file: " nil nil t))))
  27     (let ((buffer (find-file-noselect path)))
  28       (when (and (buffer-modified-p buffer)
  29                  (y-or-n-p "Save buffer? "))
  30         (save-buffer buffer))
  31       (cons buffer path))))
  32
  33 (defun geiser-compile--display-result (title ret)
  34   (if (not (geiser-eval--retort-error ret))
  35       (message "%s done" title)
  36     (message ""))
  37   (geiser-debug--display-retort title ret))
  38
  39 (defun geiser-compile--file-op (path compile-p msg)
  40   (let* ((b/p (geiser-compile--buffer/path path))
  41          (buffer (car b/p))
  42          (path (cdr b/p))
  43          (msg (format "%s %s ..." msg path))
  44          (code `(,(if compile-p :comp-file :load-file) ,path)))
  45     (message msg)
  46     (geiser-autodoc--clean-cache)
  47     (geiser-compile--display-result msg (geiser-eval--send/wait code))))
  48
  49 \f
  50 ;;; User commands:
  51
  52 (defun geiser-compile-file (path)
  53   "Compile and load Scheme file."
  54   (interactive "FScheme file: ")
  55   (geiser-compile--file-op path t "Compiling"))
  56
  57 (defun geiser-compile-current-buffer (&optional restart-p)
  58   "Compile and load current Scheme file.
  59
  60 With prefix, restart REPL before compiling the file."
  61   (interactive "P")
  62   (when restart-p (geiser-restart-repl))
  63   (geiser-compile-file (buffer-file-name (current-buffer))))
  64
  65 (defun geiser-load-file (path)
  66   "Load Scheme file."
  67   (interactive "FScheme file: ")
  68   (geiser-compile--file-op (expand-file-name path) nil "Loading"))
  69
  70 (defun geiser-load-current-buffer (&optional restart-p)
  71   "Load current Scheme file.
  72
  73 With prefix, restart REPL before loading the file."
  74   (interactive "P")
  75   (when restart-p (geiser-restart-repl))
  76   (geiser-load-file (buffer-file-name (current-buffer))))
  77
  78 (defun geiser-add-to-load-path (path)
  79   "Add a new directory to running Scheme's load path.
  80 When called interactively, this function will ask for the path to
  81 add, defaulting to the current buffer's directory."
  82   (interactive "DDirectory to add: ")
  83   (let* ((c `(:eval (:ge add-to-load-path ,(expand-file-name path))))
  84          (r (geiser-eval--send/result c)))
  85     (message "%s" (if r "Added" "Failed!"))))
  86
  87 \f
  88 (provide 'geiser-compile)