aboutsummaryrefslogtreecommitdiff
path: root/emacs/guix-geiser.el
blob: 833f5bb2b3c6bc7a1be8780ed1e9b6b52691ef57 (about) (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
;;; guix-geiser.el --- Interacting with Geiser   -*- lexical-binding: t -*-

;; Copyright © 2015 Alex Kost <alezost@gmail.com>

;; This file is part of GNU Guix.

;; GNU Guix is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Guix is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; This file provides functions to evaluate guile code using Geiser.

;;; Code:

(require 'geiser-mode)
(require 'guix-guile)

(defun guix-geiser-repl ()
  "Return the current Geiser REPL."
  (or geiser-repl--repl
      (geiser-repl--repl/impl 'guile)
      (error "Geiser REPL not found")))

(defun guix-geiser-eval (str &optional repl)
  "Evaluate STR with guile expression using Geiser REPL.
If REPL is nil, use the current Geiser REPL.
Return a list of strings with result values of evaluation."
  (with-current-buffer (or repl (guix-geiser-repl))
    (let ((res (geiser-eval--send/wait `(:eval (:scm ,str)))))
      (if (geiser-eval--retort-error res)
          (error "Error in evaluating guile expression: %s"
                 (geiser-eval--retort-output res))
        (cdr (assq 'result res))))))

(defun guix-geiser-eval-read (str &optional repl)
  "Evaluate STR with guile expression using Geiser REPL.
Return elisp expression of the first result value of evaluation."
  ;; The goal is to convert a string with scheme expression into elisp
  ;; expression.
  (let ((result (car (guix-geiser-eval str repl))))
    (cond
     ((or (string= result "#f")
          (string= result "#<unspecified>"))
      nil)
     ((string= result "#t")
      t)
     (t
      (read (replace-regexp-in-string
             "[ (]\\(#f\\)" "nil"
             (replace-regexp-in-string
              "[ (]\\(#t\\)" "t"
              result
              nil nil 1)
             nil nil 1))))))

(defun guix-repl-send (cmd &optional save-history)
  "Send CMD input string to the current REPL buffer.
This is the same as `geiser-repl--send', but with SAVE-HISTORY
argument.  If SAVE-HISTORY is non-nil, save CMD in the REPL
history."
  (when (and cmd (eq major-mode 'geiser-repl-mode))
    (geiser-repl--prepare-send)
    (goto-char (point-max))
    (comint-kill-input)
    (insert cmd)
    (let ((comint-input-filter (if save-history
                                   comint-input-filter
                                 'ignore)))
      (comint-send-input nil t))))

(defun guix-geiser-eval-in-repl (str &optional repl no-history no-display)
  "Switch to Geiser REPL and evaluate STR with guile expression there.
If NO-HISTORY is non-nil, do not save STR in the REPL history.
If NO-DISPLAY is non-nil, do not switch to the REPL buffer."
  (let ((repl (or repl (guix-geiser-repl))))
    (with-current-buffer repl
      ;; XXX Since Geiser 0.8, `geiser-repl--send' has SAVE-HISTORY
      ;; argument, so use this function eventually and remove
      ;; `guix-repl-send'.
      (guix-repl-send str (not no-history)))
    (unless no-display
      (geiser-repl--switch-to-buffer repl))))

(defun guix-geiser-eval-in-repl-synchronously (str &optional repl
                                                   no-history no-display)
  "Evaluate STR in Geiser REPL synchronously, i.e. wait until the
REPL operation will be finished.
See `guix-geiser-eval-in-repl' for the meaning of arguments."
  (let* ((repl (if repl (get-buffer repl) (guix-geiser-repl)))
         (running? nil)
         (filter (lambda (output)
                   (setq running?
                         (and (get-buffer-process repl)
                              (not (guix-guile-prompt? output))))))
         (comint-output-filter-functions
          (cons filter comint-output-filter-functions)))
    (guix-geiser-eval-in-repl str repl no-history no-display)
    (while running?
      (sleep-for 0.1))))

(defun guix-geiser-call (proc &rest args)
  "Call (PROC ARGS ...) synchronously using the current Geiser REPL.
PROC and ARGS should be strings."
  (guix-geiser-eval
   (apply #'guix-guile-make-call-expression proc args)))

(defun guix-geiser-call-in-repl (proc &rest args)
  "Call (PROC ARGS ...) in the current Geiser REPL.
PROC and ARGS should be strings."
  (guix-geiser-eval-in-repl
   (apply #'guix-guile-make-call-expression proc args)))

(provide 'guix-geiser)

;;; guix-geiser.el ends here
tom of the file....This was left over when debugging the system test. * gnu/tests/mail.scm: Remove %getmail-os from the bottom of the file. Christopher Baines 2019-06-19tests: Fix opensmtpd test....* gnu/tests/mail.scm (run-opensmtpd-test) <"mail arrived">: Invoke smtpctl by its full file name. Tobias Geerinckx-Rice 2019-05-31services: Add getmail....Getmail is a mail retriever written in Python, this commit adds a service-type to run getmail. I'm looking at this, as it's a convinient way of getting mailing list messages in to Patchwork. I initially tried putting this in the (gnu services mail) module, but due to also trying to use the define-configuration pattern, it conflicted with the dovecot service. * gnu/services/getmail.scm: New file. * gnu/local.mk: Add it. * gnu/tests/mail.scm (%getmail-os, %test-getmail): New variables. (run-getmail-test): New procedure. Christopher Baines 2018-10-18services: dhcp-client: Deprecate 'dhcp-client-service' procedure....* gnu/services/networking.scm (dhcp-client-service-type): Add default value. * gnu/system/examples/bare-bones.tmpl: Use (service dhcp-client-service-type) instead of (dhcp-client-service). * gnu/system/examples/beaglebone-black.tmpl: Likewise. * gnu/tests/base.scm (%avahi-os): Likewise. * gnu/tests/databases.scm (%memcached-os): Likewise. (%mongodb-os): Likewise. * gnu/tests/dict.scm (%dicod-os): Likewise. * gnu/tests/mail.scm (%opensmtpd-os): Likewise. (%exim-os): Likewise. (%dovecot-os): Likewise. * gnu/tests/messaging.scm (run-xmpp-test): Likewise. (run-bitlbee-test): Likewise. * gnu/tests/monitoring.scm (%prometheus-node-exporter-os): Likewise. * gnu/tests/networking.scm (%inetd-os): Likewise. (run-iptables-test): Likewise. * gnu/tests/nfs.scm (%base-os): Likewise. * gnu/tests/rsync.scm (%rsync-os): Likewise. * gnu/tests/ssh.scm (run-ssh-test): Likewise. * gnu/tests/version-control.scm (%cgit-os): Likewise. (%git-http-os): Likewise. (%gitolite-os): Likewise. * gnu/tests/virtualization.scm (%libvirt-os): Likewise. * gnu/tests/web.scm (%httpd-os): Likewise. (%nginx-os): Likewise. (%varnish-os): Likewise. (%php-fpm-os): Likewise. (%hpcguix-web-os): Likewise. (%tailon-os): Likewise. * tests/guix-system.sh: Likewise. * doc/guix.texi (Networking Services): Document 'dhcp-client-service-type' and remove 'dhcp-client-service'. Ludovic Courtès 2018-06-13tests: Honor the return value of 'start-service'....Since commit dc7b3e56337ee9d8dcd8fe7d5cab71ef536d024f, 'start-service' returns the Shepherd's representation of the service as a sexp, and '#f' if the service fails to start. Also, it doesn't throw an exception when the service fails to start, so relying on an exception instead of relying on its return value is a false positive. * gnu/tests/base.scm (run-nss-mdns-test): Split tests so to check the return value of 'start-service'. (run-mcron-test, run-nss-mdns-test): Use 'test-assert' with the return value of 'start-service'. * gnu/tests/admin.scm (run-tailon-test): Idem. * gnu/tests/dict.scm (run-dicod-test): Idem. * gnu/tests/mail.scm (run-opensmtpd-test, run-exim-test, run-dovecot-test): Idem. * gnu/tests/messaging.scm (run-xmpp-test, run-bitlbee-test): Idem. * gnu/tests/nfs.scm (run-nfs-test): Idem. * gnu/tests/rsync.scm (run-rsync-test): Idem. * gnu/tests/ssh.scm (run-ssh-test): Idem. * gnu/tests/version-control.scm (run-cgit-test, run-git-http-test): Idem. * gnu/tests/web.scm (run-php-fpm-test): Idem. Clément Lassieur 2018-03-09tests: mail: Add test for dovecot....* gnu/tests/mail.scm (%dovecot-os, %test-dovecot): New variables. (run-dovecot-test): New procedure. Oleg Pykhalov 2017-07-20tests: Use 'virtual-machine' records instead of monadic procedures....* gnu/tests/base.scm (%test-basic-os): Use 'let*' instead of 'mlet*' and 'virtual-machine' instead of 'system-qemu-image/shared-store-script'. (run-mcron-test): Likewise. (run-nss-mdns-test): Likewise. * gnu/tests/dict.scm (run-dicod-test): Likewise. * gnu/tests/mail.scm (run-opensmtpd-test): Likewise. (run-exim-test): Likewise. * gnu/tests/messaging.scm (run-xmpp-test): Likewise. * gnu/tests/networking.scm (run-inetd-test): Likewise. * gnu/tests/nfs.scm (run-nfs-test): Likewise. * gnu/tests/ssh.scm (run-ssh-test): Likewise. * gnu/tests/web.scm (run-nginx-test): Likewise. Ludovic Courtès 2017-04-19tests: mail: Add test for exim...* gnu/tests/mail.scm (%exim-os, %test-exim): New variables. (run-exim-test): New procedure. Signed-off-by: Ludovic Courtès <ludo@gnu.org> Carlo Zancanaro 2017-04-01tests: Introduce 'simple-operating-system' and use it....* gnu/tests.scm (%simple-os): New macro. (simple-operating-system): New macro. * gnu/tests/base.scm (%simple-os): Define using 'simple-operating-system'. (%mcron-os): Use 'simple-operating-system'. * gnu/tests/mail.scm (%opensmtpd-os): Likewise. * gnu/tests/messaging.scm (%base-os, os-with-service): Remove. (run-xmpp-test): Use 'simple-operating-system'. * gnu/tests/networking.scm (%inetd-os): Likewise. * gnu/tests/ssh.scm (%base-os, os-with-service): Remove. (run-ssh-test): Use 'simple-operating-system'. * gnu/tests/web.scm (%nginx-os): Likewise. Ludovic Courtès