elisp/geiser-compile.el

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