summary refs log tree commit diff
path: root/emacs
diff options
context:
space:
mode:
Diffstat (limited to 'emacs')
-rw-r--r--emacs/guix-backend.el65
-rw-r--r--emacs/guix-base.el17
-rw-r--r--emacs/guix-build-log.el333
-rw-r--r--emacs/guix-command.el26
-rw-r--r--emacs/guix-geiser.el97
-rw-r--r--emacs/guix-guile.el54
-rw-r--r--emacs/guix-info.el49
-rw-r--r--emacs/guix-list.el11
-rw-r--r--emacs/guix-main.scm20
-rw-r--r--emacs/guix-prettify.el11
-rw-r--r--emacs/guix-utils.el18
-rw-r--r--emacs/guix.el5
12 files changed, 611 insertions, 95 deletions
diff --git a/emacs/guix-backend.el b/emacs/guix-backend.el
index 7db1daacf0..412d648b9d 100644
--- a/emacs/guix-backend.el
+++ b/emacs/guix-backend.el
@@ -1,6 +1,6 @@
-;;; guix-backend.el --- Communication with Geiser
+;;; guix-backend.el --- Making and using Guix REPL
 
-;; Copyright © 2014 Alex Kost <alezost@gmail.com>
+;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com>
 
 ;; This file is part of GNU Guix.
 
@@ -19,9 +19,10 @@
 
 ;;; Commentary:
 
-;; This file provides the code for interacting with Guile using Geiser.
+;; This file provides the code for interacting with Guile using Guix REPL
+;; (Geiser REPL with some guix-specific additions).
 
-;; By default (if `guix-use-guile-server' is non-nil) 2 Geiser REPLs are
+;; By default (if `guix-use-guile-server' is non-nil) 2 Guix REPLs are
 ;; started.  The main one (with "guile --listen" process) is used for
 ;; "interacting" with a user - for showing a progress of
 ;; installing/deleting Guix packages.  The second (internal) REPL is
@@ -52,6 +53,8 @@
 ;;; Code:
 
 (require 'geiser-mode)
+(require 'geiser-guile)
+(require 'guix-geiser)
 (require 'guix-config)
 (require 'guix-emacs)
 
@@ -305,46 +308,15 @@ additional internal REPL if it exists."
 (defvar guix-operation-buffer nil
   "Buffer from which the latest Guix operation was performed.")
 
-(defun guix-make-guile-expression (fun &rest args)
-  "Return string containing a guile expression for calling FUN with ARGS."
-  (format "(%S %s)" fun
-          (mapconcat
-           (lambda (arg)
-             (cond
-              ((null arg) "'()")
-              ((or (eq arg t)
-                   ;; An ugly hack to separate 'false' from nil
-                   (equal arg 'f)
-                   (keywordp arg))
-               (concat "#" (prin1-to-string arg t)))
-              ((or (symbolp arg) (listp arg))
-               (concat "'" (prin1-to-string arg)))
-              (t (prin1-to-string arg))))
-           args
-           " ")))
-
-(defun guix-eval (str &optional wrap)
-  "Evaluate guile expression STR.
-If WRAP is non-nil, wrap STR into (begin ...) form.
-Return a list of strings with result values of evaluation."
-  (with-current-buffer (guix-get-repl-buffer 'internal)
-    (let* ((wrapped (if wrap (geiser-debug--wrap-region str) str))
-           (code `(:eval (:scm ,wrapped)))
-           (ret (geiser-eval--send/wait code)))
-      (if (geiser-eval--retort-error ret)
-          (error "Error in evaluating guile expression: %s"
-                 (geiser-eval--retort-output ret))
-        (cdr (assq 'result ret))))))
-
-(defun guix-eval-read (str &optional wrap)
-  "Evaluate guile expression STR.
-For the meaning of WRAP, see `guix-eval'.
-Return elisp expression of the first result value of evaluation."
-  ;; Parsing scheme code with elisp `read' is probably not the best idea.
-  (read (replace-regexp-in-string
-         "#f\\|#<unspecified>" "nil"
-         (replace-regexp-in-string
-          "#t" "t" (car (guix-eval str wrap))))))
+(defun guix-eval (str)
+  "Evaluate STR with guile expression using Guix REPL.
+See `guix-geiser-eval' for details."
+  (guix-geiser-eval str (guix-get-repl-buffer 'internal)))
+
+(defun guix-eval-read (str)
+  "Evaluate STR with guile expression using Guix REPL.
+See `guix-geiser-eval-read' for details."
+  (guix-geiser-eval-read str (guix-get-repl-buffer 'internal)))
 
 (defun guix-eval-in-repl (str &optional operation-buffer operation-type)
   "Switch to Guix REPL and evaluate STR with guile expression there.
@@ -358,10 +330,7 @@ successful executing of the current operation,
   (setq guix-repl-operation-p t
         guix-repl-operation-type operation-type
         guix-operation-buffer operation-buffer)
-  (let ((repl (guix-get-repl-buffer)))
-    (with-current-buffer repl
-      (geiser-repl--send str))
-    (geiser-repl--switch-to-buffer repl)))
+  (guix-geiser-eval-in-repl str (guix-get-repl-buffer)))
 
 (provide 'guix-backend)
 
diff --git a/emacs/guix-base.el b/emacs/guix-base.el
index 3bee910b05..e64e375e33 100644
--- a/emacs/guix-base.el
+++ b/emacs/guix-base.el
@@ -30,6 +30,7 @@
 (require 'cl-lib)
 (require 'guix-profiles)
 (require 'guix-backend)
+(require 'guix-guile)
 (require 'guix-utils)
 (require 'guix-history)
 (require 'guix-messages)
@@ -414,6 +415,7 @@ following keywords are available:
          (buf-str        (concat buf-type-str " buffer"))
          (prefix         (concat "guix-" entry-type-str "-" buf-type-str))
          (group          (intern prefix))
+         (faces-group    (intern (concat prefix "-faces")))
          (mode-map-str   (concat prefix "-mode-map"))
          (parent-mode    (intern (concat "guix-" buf-type-str "-mode")))
          (mode           (intern (concat prefix "-mode")))
@@ -442,6 +444,10 @@ following keywords are available:
          :prefix ,(concat prefix "-")
          :group ',(intern (concat "guix-" buf-type-str)))
 
+       (defgroup ,faces-group nil
+         ,(concat "Faces for " buf-type-str " buffer with " entry-str ".")
+         :group ',(intern (concat "guix-" buf-type-str "-faces")))
+
        (defcustom ,buf-name-var ,buf-name-val
          ,(concat "Default name of the " buf-str " for displaying " entry-str ".")
          :type 'string
@@ -789,7 +795,7 @@ GENERATION is a generation number of `guix-profile' profile."
 (defface guix-operation-option-key
   '((t :inherit font-lock-warning-face))
   "Face used for the keys of operation options."
-  :group 'guix)
+  :group 'guix-faces)
 
 (defcustom guix-operation-confirm t
   "If nil, do not prompt to confirm an operation."
@@ -1129,9 +1135,12 @@ The function is called with a single argument - a command line string."
 
 (defun guix-command-output (args)
   "Return string with 'guix ARGS ...' output."
-  (guix-eval-read
-   (apply #'guix-make-guile-expression
-          'guix-command-output args)))
+  (cl-multiple-value-bind (output error)
+      (guix-eval (apply #'guix-make-guile-expression
+                        'guix-command-output args))
+    ;; Remove trailing new space from the error string.
+    (message (replace-regexp-in-string "\n\\'" "" (read error)))
+    (read output)))
 
 (defun guix-help-string (&optional commands)
   "Return string with 'guix COMMANDS ... --help' output."
diff --git a/emacs/guix-build-log.el b/emacs/guix-build-log.el
new file mode 100644
index 0000000000..6faa37c311
--- /dev/null
+++ b/emacs/guix-build-log.el
@@ -0,0 +1,333 @@
+;;; guix-build-log.el --- Major and minor modes for build logs   -*- 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 a major mode (`guix-build-log-mode') and a minor mode
+;; (`guix-build-log-minor-mode') for highlighting Guix build logs.
+
+;;; Code:
+
+(defgroup guix-build-log nil
+  "Settings for `guix-build-log-mode'."
+  :group 'guix)
+
+(defgroup guix-build-log-faces nil
+  "Faces for `guix-build-log-mode'."
+  :group 'guix-build-log
+  :group 'guix-faces)
+
+(defface guix-build-log-title-head
+  '((t :inherit font-lock-keyword-face))
+  "Face for '@' symbol of a log title."
+  :group 'guix-build-log-faces)
+
+(defface guix-build-log-title-start
+  '((t :inherit guix-build-log-title-head))
+  "Face for a log title denoting a start of a process."
+  :group 'guix-build-log-faces)
+
+(defface guix-build-log-title-success
+  '((t :inherit guix-build-log-title-head))
+  "Face for a log title denoting a successful end of a process."
+  :group 'guix-build-log-faces)
+
+(defface guix-build-log-title-fail
+  '((t :inherit error))
+  "Face for a log title denoting a failed end of a process."
+  :group 'guix-build-log-faces)
+
+(defface guix-build-log-title-end
+  '((t :inherit guix-build-log-title-head))
+  "Face for a log title denoting an undefined end of a process."
+  :group 'guix-build-log-faces)
+
+(defface guix-build-log-phase-name
+  '((t :inherit font-lock-function-name-face))
+  "Face for a phase name."
+  :group 'guix-build-log-faces)
+
+(defface guix-build-log-phase-start
+  '((default :weight bold)
+    (((class grayscale) (background light)) :foreground "Gray90")
+    (((class grayscale) (background dark))  :foreground "DimGray")
+    (((class color) (min-colors 16) (background light))
+     :foreground "DarkGreen")
+    (((class color) (min-colors 16) (background dark))
+     :foreground "LimeGreen")
+    (((class color) (min-colors 8)) :foreground "green"))
+  "Face for the start line of a phase."
+  :group 'guix-build-log-faces)
+
+(defface guix-build-log-phase-end
+  '((((class grayscale) (background light)) :foreground "Gray90")
+    (((class grayscale) (background dark))  :foreground "DimGray")
+    (((class color) (min-colors 16) (background light))
+     :foreground "ForestGreen")
+    (((class color) (min-colors 16) (background dark))
+     :foreground "LightGreen")
+    (((class color) (min-colors 8)) :foreground "green")
+    (t :weight bold))
+  "Face for the end line of a phase."
+  :group 'guix-build-log-faces)
+
+(defface guix-build-log-phase-success
+  '((t))
+  "Face for the 'succeeded' word of a phase line."
+  :group 'guix-build-log-faces)
+
+(defface guix-build-log-phase-fail
+  '((t :inherit error))
+  "Face for the 'failed' word of a phase line."
+  :group 'guix-build-log-faces)
+
+(defface guix-build-log-phase-seconds
+  '((t :inherit font-lock-constant-face))
+  "Face for the number of seconds for a phase."
+  :group 'guix-build-log-faces)
+
+(defcustom guix-build-log-mode-hook
+  ;; Not using `compilation-minor-mode' because it rebinds some standard
+  ;; keys, including M-n/M-p.
+  '(compilation-shell-minor-mode view-mode)
+  "Hook run after `guix-build-log-mode' is entered."
+  :type 'hook
+  :group 'guix-build-log)
+
+(defvar guix-build-log-phase-name-regexp "`\\([^']+\\)'"
+  "Regexp for a phase name.")
+
+(defvar guix-build-log-phase-start-regexp
+  (concat "^starting phase " guix-build-log-phase-name-regexp)
+  "Regexp for the start line of a 'build' phase.")
+
+(defun guix-build-log-title-regexp (&optional state)
+  "Return regexp for the log title.
+STATE is a symbol denoting a state of the title.  It should be
+`start', `fail', `success' or `nil' (for a regexp matching any
+state)."
+  (let* ((word-rx (rx (1+ (any word "-"))))
+         (state-rx (cond ((eq state 'start)   (concat word-rx "started"))
+                         ((eq state 'success) (concat word-rx "succeeded"))
+                         ((eq state 'fail)    (concat word-rx "failed"))
+                         (t word-rx))))
+    (rx-to-string
+     `(and bol (group "@") " " (group (regexp ,state-rx)))
+     t)))
+
+(defun guix-build-log-phase-end-regexp (&optional state)
+  "Return regexp for the end line of a 'build' phase.
+STATE is a symbol denoting how a build phase was ended.  It should be
+`fail', `success' or `nil' (for a regexp matching any state)."
+  (let ((state-rx (cond ((eq state 'success) "succeeded")
+                        ((eq state 'fail)    "failed")
+                        (t (regexp-opt '("succeeded" "failed"))))))
+    (rx-to-string
+     `(and bol "phase " (regexp ,guix-build-log-phase-name-regexp)
+           " " (group (regexp ,state-rx)) " after "
+           (group (1+ digit)) " seconds")
+     t)))
+
+(defvar guix-build-log-phase-end-regexp
+  ;; For efficiency, it is better to have a regexp for the general line
+  ;; of the phase end, then to call the function all the time.
+  (guix-build-log-phase-end-regexp)
+  "Regexp for the end line of a 'build' phase.")
+
+(defvar guix-build-log-font-lock-keywords
+  `((,(guix-build-log-title-regexp 'start)
+     (1 'guix-build-log-title-head)
+     (2 'guix-build-log-title-start))
+    (,(guix-build-log-title-regexp 'success)
+     (1 'guix-build-log-title-head)
+     (2 'guix-build-log-title-success))
+    (,(guix-build-log-title-regexp 'fail)
+     (1 'guix-build-log-title-head)
+     (2 'guix-build-log-title-fail))
+    (,(guix-build-log-title-regexp)
+     (1 'guix-build-log-title-head)
+     (2 'guix-build-log-title-end))
+    (,guix-build-log-phase-start-regexp
+     (0 'guix-build-log-phase-start)
+     (1 'guix-build-log-phase-name prepend))
+    (,(guix-build-log-phase-end-regexp 'success)
+     (0 'guix-build-log-phase-end)
+     (1 'guix-build-log-phase-name prepend)
+     (2 'guix-build-log-phase-success prepend)
+     (3 'guix-build-log-phase-seconds prepend))
+    (,(guix-build-log-phase-end-regexp 'fail)
+     (0 'guix-build-log-phase-end)
+     (1 'guix-build-log-phase-name prepend)
+     (2 'guix-build-log-phase-fail prepend)
+     (3 'guix-build-log-phase-seconds prepend)))
+  "A list of `font-lock-keywords' for `guix-build-log-mode'.")
+
+(defvar guix-build-log-mode-map
+  (let ((map (make-sparse-keymap)))
+    (set-keymap-parent map special-mode-map)
+    (define-key map (kbd "M-n") 'guix-build-log-next-phase)
+    (define-key map (kbd "M-p") 'guix-build-log-previous-phase)
+    (define-key map (kbd "TAB") 'guix-build-log-phase-toggle)
+    (define-key map (kbd "<tab>") 'guix-build-log-phase-toggle)
+    (define-key map (kbd "<backtab>") 'guix-build-log-phase-toggle-all)
+    (define-key map [(shift tab)] 'guix-build-log-phase-toggle-all)
+    map)
+  "Keymap for `guix-build-log-mode' buffers.")
+
+(defun guix-build-log-phase-start (&optional with-header?)
+  "Return the start point of the current build phase.
+If WITH-HEADER? is non-nil, do not skip 'starting phase ...' header.
+Return nil, if there is no phase start before the current point."
+  (save-excursion
+    (end-of-line)
+    (when (re-search-backward guix-build-log-phase-start-regexp nil t)
+      (unless with-header? (end-of-line))
+      (point))))
+
+(defun guix-build-log-phase-end ()
+  "Return the end point of the current build phase."
+  (save-excursion
+    (beginning-of-line)
+    (when (re-search-forward guix-build-log-phase-end-regexp nil t)
+      (point))))
+
+(defun guix-build-log-phase-hide ()
+  "Hide the body of the current build phase."
+  (interactive)
+  (let ((beg (guix-build-log-phase-start))
+        (end (guix-build-log-phase-end)))
+    (when (and beg end)
+      ;; If not on the header line, move to it.
+      (when (and (> (point) beg)
+                 (< (point) end))
+        (goto-char (guix-build-log-phase-start t)))
+      (remove-overlays beg end 'invisible t)
+      (let ((o (make-overlay beg end)))
+        (overlay-put o 'evaporate t)
+        (overlay-put o 'invisible t)))))
+
+(defun guix-build-log-phase-show ()
+  "Show the body of the current build phase."
+  (interactive)
+  (let ((beg (guix-build-log-phase-start))
+        (end (guix-build-log-phase-end)))
+    (when (and beg end)
+      (remove-overlays beg end 'invisible t))))
+
+(defun guix-build-log-phase-hidden-p ()
+  "Return non-nil, if the body of the current build phase is hidden."
+  (let ((beg (guix-build-log-phase-start)))
+    (and beg
+         (cl-some (lambda (o)
+                    (overlay-get o 'invisible))
+                  (overlays-at beg)))))
+
+(defun guix-build-log-phase-toggle-function ()
+  "Return a function to toggle the body of the current build phase."
+  (if (guix-build-log-phase-hidden-p)
+      #'guix-build-log-phase-show
+    #'guix-build-log-phase-hide))
+
+(defun guix-build-log-phase-toggle ()
+  "Show/hide the body of the current build phase."
+  (interactive)
+  (funcall (guix-build-log-phase-toggle-function)))
+
+(defun guix-build-log-phase-toggle-all ()
+  "Show/hide the bodies of all build phases."
+  (interactive)
+  (save-excursion
+    ;; Some phases may be hidden, and some shown.  Whether to hide or to
+    ;; show them, it is determined by the state of the first phase here.
+    (goto-char (point-min))
+    (guix-build-log-next-phase)
+    (let ((fun (guix-build-log-phase-toggle-function)))
+      (while (re-search-forward guix-build-log-phase-start-regexp nil t)
+        (funcall fun)))))
+
+(defun guix-build-log-next-phase (&optional arg)
+  "Move to the next build phase.
+With ARG, do it that many times.  Negative ARG means move
+backward."
+  (interactive "^p")
+  (if arg
+      (when (zerop arg) (user-error "Try again"))
+    (setq arg 1))
+  (let ((search-fun (if (> arg 0)
+                        #'re-search-forward
+                      #'re-search-backward))
+        (n (abs arg))
+        found last-found)
+    (save-excursion
+      (end-of-line (if (> arg 0) 1 0))  ; skip the current line
+      (while (and (not (zerop n))
+                  (setq found
+                        (funcall search-fun
+                                 guix-build-log-phase-start-regexp
+                                 nil t)))
+        (setq n (1- n)
+              last-found found)))
+    (when last-found
+      (goto-char last-found)
+      (forward-line 0))
+    (or found
+        (user-error (if (> arg 0)
+                        "No next build phase"
+                      "No previous build phase")))))
+
+(defun guix-build-log-previous-phase (&optional arg)
+  "Move to the previous build phase.
+With ARG, do it that many times.  Negative ARG means move
+forward."
+  (interactive "^p")
+  (guix-build-log-next-phase (- (or arg 1))))
+
+;;;###autoload
+(define-derived-mode guix-build-log-mode special-mode
+  "Guix-Build-Log"
+  "Major mode for viewing Guix build logs.
+
+\\{guix-build-log-mode-map}"
+  (setq font-lock-defaults '(guix-build-log-font-lock-keywords t)))
+
+;;;###autoload
+(define-minor-mode guix-build-log-minor-mode
+  "Toggle Guix Build Log minor mode.
+
+With a prefix argument ARG, enable Guix Build Log minor mode if
+ARG is positive, and disable it otherwise.  If called from Lisp,
+enable the mode if ARG is omitted or nil.
+
+When Guix Build Log minor mode is enabled, it highlights build
+log in the current buffer.  This mode can be enabled
+programmatically using hooks:
+
+  (add-hook 'shell-mode-hook 'guix-build-log-minor-mode)"
+  :init-value nil
+  :lighter " Guix-Build-Log"
+  :group 'guix-build-log
+  (if guix-build-log-minor-mode
+      (font-lock-add-keywords nil guix-build-log-font-lock-keywords)
+    (font-lock-remove-keywords nil guix-build-log-font-lock-keywords))
+  (when font-lock-mode
+    (font-lock-fontify-buffer)))
+
+(provide 'guix-build-log)
+
+;;; guix-build-log.el ends here
diff --git a/emacs/guix-command.el b/emacs/guix-command.el
index 81f619f434..504d5f7ca0 100644
--- a/emacs/guix-command.el
+++ b/emacs/guix-command.el
@@ -65,6 +65,7 @@
 (require 'guix-help-vars)
 (require 'guix-read)
 (require 'guix-base)
+(require 'guix-guile)
 (require 'guix-external)
 
 (defgroup guix-commands nil
@@ -305,9 +306,9 @@ to be modified."
 
 (defun guix-command-improve-argument (argument improvers)
   "Return ARGUMENT modified with IMPROVERS."
-  (or (guix-any (lambda (improver)
-                  (funcall improver argument))
-                improvers)
+  (or (cl-some (lambda (improver)
+                 (funcall improver argument))
+               improvers)
       argument))
 
 (defun guix-command-improve-arguments (arguments commands)
@@ -497,7 +498,10 @@ to be modified."
   "List of default 'execute' action arguments.")
 
 (defvar guix-command-additional-execute-arguments
-  `((("graph")
+  `((("build")
+     ,(guix-command-make-argument
+       :name "log" :char ?l :doc "View build log"))
+    (("graph")
      ,(guix-command-make-argument
        :name "view" :char ?v :doc "View graph")))
   "Alist of guix commands and additional 'execute' action arguments.")
@@ -518,6 +522,8 @@ to be modified."
      ("repl" . guix-run-environment-command-in-repl))
     (("pull")
      ("repl" . guix-run-pull-command-in-repl))
+    (("build")
+     ("log" . guix-run-view-build-log))
     (("graph")
      ("view" . guix-run-view-graph)))
   "Alist of guix commands and alists of special executers for them.
@@ -556,6 +562,18 @@ Perform pull-specific actions after operation, see
    (apply #'guix-make-guile-expression 'guix-command args)
    nil 'pull))
 
+(defun guix-run-view-build-log (args)
+  "Add --log-file to ARGS, run 'guix ARGS ...' build command, and
+open the log file(s)."
+  (let* ((args (if (member "--log-file" args)
+                   args
+                 (apply #'list (car args) "--log-file" (cdr args))))
+         (output (guix-command-output args))
+         (files  (split-string output "\n" t)))
+    (dolist (file files)
+      (guix-find-file-or-url file)
+      (guix-build-log-mode))))
+
 (defun guix-run-view-graph (args)
   "Run 'guix ARGS ...' graph command, make the image and open it."
   (let* ((graph-file (guix-dot-file-name))
diff --git a/emacs/guix-geiser.el b/emacs/guix-geiser.el
new file mode 100644
index 0000000000..eb449bcdb1
--- /dev/null
+++ b/emacs/guix-geiser.el
@@ -0,0 +1,97 @@
+;;; 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."
+  ;; Parsing scheme code with elisp `read' is probably not the best idea.
+  (read (replace-regexp-in-string
+         "#f\\|#<unspecified>" "nil"
+         (replace-regexp-in-string
+          "#t" "t" (car (guix-geiser-eval str repl))))))
+
+(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-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
diff --git a/emacs/guix-guile.el b/emacs/guix-guile.el
new file mode 100644
index 0000000000..cff9bd4e9b
--- /dev/null
+++ b/emacs/guix-guile.el
@@ -0,0 +1,54 @@
+;;; guix-guile.el --- Auxiliary tools for working with guile code   -*- 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 for parsing guile code, making guile
+;; expressions, etc.
+
+;;; Code:
+
+(defun guix-guile-make-call-expression (proc &rest args)
+  "Return \"(PROC ARGS ...)\" string.
+PROC and ARGS should be strings."
+  (format "(%s %s)"
+          proc
+          (mapconcat #'identity args " ")))
+
+(defun guix-make-guile-expression (fun &rest args)
+  "Return string containing a guile expression for calling FUN with ARGS."
+  (format "(%S %s)" fun
+          (mapconcat
+           (lambda (arg)
+             (cond
+              ((null arg) "'()")
+              ((or (eq arg t)
+                   ;; An ugly hack to separate 'false' from nil.
+                   (equal arg 'f)
+                   (keywordp arg))
+               (concat "#" (prin1-to-string arg t)))
+              ((or (symbolp arg) (listp arg))
+               (concat "'" (prin1-to-string arg)))
+              (t (prin1-to-string arg))))
+           args
+           " ")))
+
+(provide 'guix-guile)
+
+;;; guix-guile.el ends here
diff --git a/emacs/guix-info.el b/emacs/guix-info.el
index 4bdd62a6a5..260c7680f5 100644
--- a/emacs/guix-info.el
+++ b/emacs/guix-info.el
@@ -33,25 +33,30 @@
   :prefix "guix-info-"
   :group 'guix)
 
+(defgroup guix-info-faces nil
+  "Faces for info buffers."
+  :group 'guix-info
+  :group 'guix-faces)
+
 (defface guix-info-param-title
   '((t :inherit font-lock-type-face))
   "Face used for titles of parameters."
-  :group 'guix-info)
+  :group 'guix-info-faces)
 
 (defface guix-info-file-path
   '((t :inherit link))
   "Face used for file paths."
-  :group 'guix-info)
+  :group 'guix-info-faces)
 
 (defface guix-info-url
   '((t :inherit link))
   "Face used for URLs."
-  :group 'guix-info)
+  :group 'guix-info-faces)
 
 (defface guix-info-time
   '((t :inherit font-lock-constant-face))
   "Face used for timestamps."
-  :group 'guix-info)
+  :group 'guix-info-faces)
 
 (defface guix-info-action-button
   '((((type x w32 ns) (class color))
@@ -59,7 +64,7 @@
      :background "lightgrey" :foreground "black")
     (t :inherit button))
   "Face used for action buttons."
-  :group 'guix-info)
+  :group 'guix-info-faces)
 
 (defface guix-info-action-button-mouse
   '((((type x w32 ns) (class color))
@@ -67,7 +72,7 @@
      :background "grey90" :foreground "black")
     (t :inherit highlight))
   "Mouse face used for action buttons."
-  :group 'guix-info)
+  :group 'guix-info-faces)
 
 (defcustom guix-info-ignore-empty-vals nil
   "If non-nil, do not display parameters with nil values."
@@ -414,43 +419,43 @@ See `insert-text-button' for the meaning of PROPERTIES."
   '((((type tty pc) (class color)) :weight bold)
     (t :height 1.6 :weight bold :inherit variable-pitch))
   "Face for package name and version headings."
-  :group 'guix-package-info)
+  :group 'guix-package-info-faces)
 
 (defface guix-package-info-name
   '((t :inherit font-lock-keyword-face))
   "Face used for a name of a package."
-  :group 'guix-package-info)
+  :group 'guix-package-info-faces)
 
 (defface guix-package-info-name-button
   '((t :inherit button))
   "Face used for a full name that can be used to describe a package."
-  :group 'guix-package-info)
+  :group 'guix-package-info-faces)
 
 (defface guix-package-info-version
   '((t :inherit font-lock-builtin-face))
   "Face used for a version of a package."
-  :group 'guix-package-info)
+  :group 'guix-package-info-faces)
 
 (defface guix-package-info-synopsis
   '((((type tty pc) (class color)) :weight bold)
     (t :height 1.1 :weight bold :inherit variable-pitch))
   "Face used for a synopsis of a package."
-  :group 'guix-package-info)
+  :group 'guix-package-info-faces)
 
 (defface guix-package-info-description
   '((t))
   "Face used for a description of a package."
-  :group 'guix-package-info)
+  :group 'guix-package-info-faces)
 
 (defface guix-package-info-license
   '((t :inherit font-lock-string-face))
   "Face used for a license of a package."
-  :group 'guix-package-info)
+  :group 'guix-package-info-faces)
 
 (defface guix-package-info-location
   '((t :inherit link))
   "Face used for a location of a package."
-  :group 'guix-package-info)
+  :group 'guix-package-info-faces)
 
 (defface guix-package-info-installed-outputs
   '((default :weight bold)
@@ -462,17 +467,17 @@ See `insert-text-button' for the meaning of PROPERTIES."
      :foreground "green")
     (t :underline t))
   "Face used for installed outputs of a package."
-  :group 'guix-package-info)
+  :group 'guix-package-info-faces)
 
 (defface guix-package-info-uninstalled-outputs
   '((t :weight bold))
   "Face used for uninstalled outputs of a package."
-  :group 'guix-package-info)
+  :group 'guix-package-info-faces)
 
 (defface guix-package-info-obsolete
   '((t :inherit error))
   "Face used if a package is obsolete."
-  :group 'guix-package-info)
+  :group 'guix-package-info-faces)
 
 (defvar guix-info-insert-package-function
   #'guix-package-info-insert-with-heading
@@ -541,7 +546,7 @@ Face name is `guix-package-info-TYPE-inputs'."
        (defface ,face
          '((t :inherit guix-package-info-name-button))
          ,(concat "Face used for " type-desc "inputs of a package.")
-         :group 'guix-package-info)
+         :group 'guix-package-info-faces)
 
        (define-button-type ',btn
          :supertype 'guix-package-name
@@ -672,7 +677,7 @@ ENTRY is an alist with package info."
 (defface guix-package-info-source
   '((t :inherit link :underline nil))
   "Face used for a source URL of a package."
-  :group 'guix-package-info)
+  :group 'guix-package-info-faces)
 
 (defcustom guix-package-info-auto-find-source nil
   "If non-nil, find a source file after pressing a \"Show\" button.
@@ -825,17 +830,17 @@ If nil, insert output in a default way.")
 (defface guix-generation-info-number
   '((t :inherit font-lock-keyword-face))
   "Face used for a number of a generation."
-  :group 'guix-generation-info)
+  :group 'guix-generation-info-faces)
 
 (defface guix-generation-info-current
   '((t :inherit guix-package-info-installed-outputs))
   "Face used if a generation is the current one."
-  :group 'guix-generation-info)
+  :group 'guix-generation-info-faces)
 
 (defface guix-generation-info-not-current
   '((t nil))
   "Face used if a generation is not the current one."
-  :group 'guix-generation-info)
+  :group 'guix-generation-info-faces)
 
 (defvar guix-info-insert-generation-function nil
   "Function used to insert a generation information.
diff --git a/emacs/guix-list.el b/emacs/guix-list.el
index 9796464dbf..87d214bb4d 100644
--- a/emacs/guix-list.el
+++ b/emacs/guix-list.el
@@ -35,10 +35,15 @@
   :prefix "guix-list-"
   :group 'guix)
 
+(defgroup guix-list-faces nil
+  "Faces for list buffers."
+  :group 'guix-list
+  :group 'guix-faces)
+
 (defface guix-list-file-path
   '((t :inherit guix-info-file-path))
   "Face used for file paths."
-  :group 'guix-list)
+  :group 'guix-list-faces)
 
 (defcustom guix-list-describe-warning-count 10
   "The maximum number of entries for describing without a warning.
@@ -488,12 +493,12 @@ With prefix (if ARG is non-nil), describe entries marked with any mark."
 (defface guix-package-list-installed
   '((t :inherit guix-package-info-installed-outputs))
   "Face used if there are installed outputs for the current package."
-  :group 'guix-package-list)
+  :group 'guix-package-list-faces)
 
 (defface guix-package-list-obsolete
   '((t :inherit guix-package-info-obsolete))
   "Face used if a package is obsolete."
-  :group 'guix-package-list)
+  :group 'guix-package-list-faces)
 
 (defcustom guix-package-list-generation-marking-enabled nil
   "If non-nil, allow putting marks in a list with 'generation packages'.
diff --git a/emacs/guix-main.scm b/emacs/guix-main.scm
index c9b84d36d9..e29a0a0acc 100644
--- a/emacs/guix-main.scm
+++ b/emacs/guix-main.scm
@@ -71,6 +71,18 @@
 (define (list-maybe obj)
   (if (list? obj) obj (list obj)))
 
+(define (output+error thunk)
+  "Call THUNK and return 2 values: output and error output as strings."
+  (let ((output-port (open-output-string))
+        (error-port  (open-output-string)))
+    (with-output-to-port output-port
+      (lambda () (with-error-to-port error-port thunk)))
+    (let ((strings (list (get-output-string output-port)
+                         (get-output-string error-port))))
+      (close-output-port output-port)
+      (close-output-port error-port)
+      (apply values strings))))
+
 (define (full-name->name+version spec)
   "Given package specification SPEC with or without output,
 return two values: name and version.  For example, for SPEC
@@ -953,9 +965,11 @@ GENERATIONS is a list of generation numbers."
     (const #t)))
 
 (define (guix-command-output . args)
-  "Return string with 'guix ARGS ...' output."
-  (with-output-to-string
-    (lambda () (apply guix-command args))))
+  "Return 2 strings with 'guix ARGS ...' output and error output."
+  (output+error
+   (lambda ()
+     (parameterize ((guix-warning-port (current-error-port)))
+       (apply guix-command args)))))
 
 (define (help-string . commands)
   "Return string with 'guix COMMANDS ... --help' output."
diff --git a/emacs/guix-prettify.el b/emacs/guix-prettify.el
index 24dfbb33e2..38d72e860b 100644
--- a/emacs/guix-prettify.el
+++ b/emacs/guix-prettify.el
@@ -77,9 +77,14 @@ disabling `guix-prettify-mode' a little faster."
   :group 'guix-prettify)
 
 (defcustom guix-prettify-regexp
-  (rx "/"
-      (or "nix" "gnu")
-      "/store/"
+  ;; The following file names / URLs should be abbreviated:
+
+  ;; /gnu/store/…-foo-0.1
+  ;; /nix/store/…-foo-0.1
+  ;; http://hydra.gnu.org/nar/…-foo-0.1
+  ;; http://hydra.gnu.org/log/…-foo-0.1
+
+  (rx "/" (or "store" "nar" "log") "/"
       ;; Hash-parts do not include "e", "o", "u" and "t".  See base32Chars
       ;; at <https://github.com/NixOS/nix/blob/master/src/libutil/hash.cc>
       (group (= 32 (any "0-9" "a-d" "f-n" "p-s" "v-z"))))
diff --git a/emacs/guix-utils.el b/emacs/guix-utils.el
index c1ce954f8f..d1f088b6a8 100644
--- a/emacs/guix-utils.el
+++ b/emacs/guix-utils.el
@@ -208,6 +208,16 @@ single argument."
       (funcall guix-find-file-function file)
     (message "File '%s' does not exist." file)))
 
+(defvar url-handler-regexp)
+
+(defun guix-find-file-or-url (file-or-url)
+  "Find FILE-OR-URL."
+  (require 'url-handlers)
+  (let ((file-name-handler-alist
+         (cons (cons url-handler-regexp 'url-file-handler)
+               file-name-handler-alist)))
+    (find-file file-or-url)))
+
 (defmacro guix-while-search (regexp &rest body)
   "Evaluate BODY after each search for REGEXP in the current buffer."
   (declare (indent 1) (debug t))
@@ -216,14 +226,6 @@ single argument."
      (while (re-search-forward ,regexp nil t)
        ,@body)))
 
-(defun guix-any (pred lst)
-  "Test whether any element from LST satisfies PRED.
-If so, return the return value from the successful PRED call.
-Return nil otherwise."
-  (when lst
-    (or (funcall pred (car lst))
-        (guix-any pred (cdr lst)))))
-
 
 ;;; Alist accessors
 
diff --git a/emacs/guix.el b/emacs/guix.el
index 244696a184..ac6efbb475 100644
--- a/emacs/guix.el
+++ b/emacs/guix.el
@@ -39,6 +39,11 @@
   :prefix "guix-"
   :group 'external)
 
+(defgroup guix-faces nil
+  "Guix faces."
+  :group 'guix
+  :group 'faces)
+
 (defcustom guix-list-single-package nil
   "If non-nil, list a package even if it is the only matching result.
 If nil, show a single package in the info buffer."
generated by cgit-pink 1.4.1 (git 2.36.1) at 2024-09-22 17:37:04 +0000