diff options
Diffstat (limited to 'emacs')
| -rw-r--r-- | emacs/guix-backend.el | 65 | ||||
| -rw-r--r-- | emacs/guix-base.el | 17 | ||||
| -rw-r--r-- | emacs/guix-build-log.el | 333 | ||||
| -rw-r--r-- | emacs/guix-command.el | 26 | ||||
| -rw-r--r-- | emacs/guix-geiser.el | 97 | ||||
| -rw-r--r-- | emacs/guix-guile.el | 54 | ||||
| -rw-r--r-- | emacs/guix-info.el | 49 | ||||
| -rw-r--r-- | emacs/guix-list.el | 11 | ||||
| -rw-r--r-- | emacs/guix-main.scm | 20 | ||||
| -rw-r--r-- | emacs/guix-prettify.el | 11 | ||||
| -rw-r--r-- | emacs/guix-utils.el | 18 | ||||
| -rw-r--r-- | emacs/guix.el | 5 |
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." |