diff options
Diffstat (limited to 'emacs')
| -rw-r--r-- | emacs/guix-base.el | 21 | ||||
| -rw-r--r-- | emacs/guix-main.scm | 22 | ||||
| -rw-r--r-- | emacs/guix-ui-package.el | 105 | ||||
| -rw-r--r-- | emacs/guix-utils.el | 33 | ||||
| -rw-r--r-- | emacs/local.mk | 74 |
5 files changed, 208 insertions, 47 deletions
diff --git a/emacs/guix-base.el b/emacs/guix-base.el index 888836428f..658cfdb5fa 100644 --- a/emacs/guix-base.el +++ b/emacs/guix-base.el @@ -207,6 +207,13 @@ Ask a user with PROMPT for continuing an operation." (guix-make-guile-expression 'package-source-path package-id))) +(defun guix-package-store-path (package-id) + "Return a list of store directories of outputs of package PACKAGE-ID." + (message "Calculating the package derivation ...") + (guix-eval-read + (guix-make-guile-expression + 'package-store-path package-id))) + (defvar guix-after-source-download-hook nil "Hook run after successful performing a 'source-download' operation.") @@ -224,6 +231,20 @@ Ask a user with PROMPT for continuing an operation." :dry-run? (or guix-dry-run 'f)) nil 'source-download))) +(defun guix-build-package (package-id &optional prompt) + "Build package with PACKAGE-ID. +Ask a user with PROMPT for continuing the build operation." + (when (or (not guix-operation-confirm) + (guix-operation-prompt (or prompt "Build package?"))) + (guix-eval-in-repl + (format (concat ",run-in-store " + "(build-package (package-by-id %d)" + " #:use-substitutes? %s" + " #:dry-run? %s)") + package-id + (guix-guile-boolean guix-use-substitutes) + (guix-guile-boolean guix-dry-run))))) + ;;;###autoload (defun guix-apply-manifest (profile file &optional operation-buffer) "Apply manifest from FILE to PROFILE. diff --git a/emacs/guix-main.scm b/emacs/guix-main.scm index e645a85e7d..cbf7cdc474 100644 --- a/emacs/guix-main.scm +++ b/emacs/guix-main.scm @@ -51,6 +51,7 @@ (guix licenses) (guix utils) (guix ui) + (guix scripts) (guix scripts package) (gnu packages) (gnu system)) @@ -953,6 +954,17 @@ GENERATIONS is a list of generation numbers." ((package _ ...) package))) (compose location->string package-location))) +(define (package-store-path package-id) + "Return a list of store directories of outputs of package PACKAGE-ID." + (match (package-by-id package-id) + (#f '()) + (package + (with-store store + (map (match-lambda + ((_ . drv) + (derivation-output-path drv))) + (derivation-outputs (package-derivation store package))))))) + (define (package-source-derivation->store-path derivation) "Return a store path of the package source DERIVATION." (match (derivation-outputs derivation) @@ -988,6 +1000,16 @@ GENERATIONS is a list of generation numbers." (format #t "The source store path: ~a~%" (package-source-derivation->store-path derivation)))))) +(define (package-build-log-file package-id) + "Return the build log file of a package PACKAGE-ID. +Return #f if the build log is not found." + (and-let* ((package (package-by-id package-id))) + (with-store store + (let* ((derivation (package-derivation store package)) + (file (derivation-file-name derivation))) + (or (log-file store file) + ((@@ (guix scripts build) log-url) store file)))))) + ;;; Executing guix commands diff --git a/emacs/guix-ui-package.el b/emacs/guix-ui-package.el index edc36486fc..4280246bb8 100644 --- a/emacs/guix-ui-package.el +++ b/emacs/guix-ui-package.el @@ -111,6 +111,19 @@ is found and `guix-package-list-single' is nil." (list (if (= 0 package-id) package-id-str package-id) output)))) +(defun guix-package-build-log-file (id) + "Return build log file name of a package defined by ID." + (guix-eval-read + (guix-make-guile-expression 'package-build-log-file id))) + +(defun guix-package-find-build-log (id) + "Show build log of a package defined by ID." + (require 'guix-build-log) + (let ((file (guix-package-build-log-file id))) + (if file + (guix-build-log-find-file file) + (message "Couldn't find the package build log.")))) + ;;; Processing package actions @@ -222,6 +235,7 @@ ENTRIES is a list of package entries to get info about packages." (description ignore (simple guix-package-info-description)) ignore (outputs simple guix-package-info-insert-outputs) + guix-package-info-insert-misc (source simple guix-package-info-insert-source) (location simple guix-package-info-insert-location) (home-url format (format guix-url)) @@ -309,9 +323,15 @@ ENTRIES is a list of package entries to get info about packages." "Face used if a package is obsolete." :group 'guix-package-info-faces) +(defcustom guix-package-info-auto-find-package t + "If non-nil, open store directory after pressing \"Show\" package button. +If nil, just display the store directory (or directories) without finding." + :type 'boolean + :group 'guix-package-info) + (defcustom guix-package-info-auto-find-source nil - "If non-nil, find a source file after pressing a \"Show\" button. -If nil, just display the source file path without finding." + "If non-nil, open source file after pressing \"Show\" source button. +If nil, just display the source file name without finding." :type 'boolean :group 'guix-package-info) @@ -325,6 +345,14 @@ prompt depending on `guix-operation-confirm' variable)." :type 'boolean :group 'guix-package-info) +(defcustom guix-package-info-button-functions + '(guix-package-info-insert-build-button + guix-package-info-insert-build-log-button) + "List of functions used to insert package buttons in Info buffer. +Each function is called with 2 arguments: package ID and full name." + :type '(repeat function) + :group 'guix-package-info) + (defvar guix-package-info-download-buffer nil "Buffer from which a current download operation was performed.") @@ -521,6 +549,78 @@ ENTRY is an alist with package info." (guix-entry-id entry)) 'output output))) +(defun guix-package-info-show-store-path (entry-id package-id) + "Show store directories of the package outputs in the current buffer. +ENTRY-ID is an ID of the current entry (package or output). +PACKAGE-ID is an ID of the package which store path to show." + (let* ((entries (guix-buffer-current-entries)) + (entry (guix-entry-by-id entry-id entries)) + (dirs (guix-package-store-path package-id))) + (or dirs + (error "Couldn't define store directory of the package")) + (let* ((new-entry (cons (cons 'store-path dirs) + entry)) + (new-entries (guix-replace-entry entry-id new-entry entries))) + (setf (guix-buffer-item-entries guix-buffer-item) + new-entries) + (guix-buffer-redisplay-goto-button) + (let ((dir (car dirs))) + (if (file-exists-p dir) + (if guix-package-info-auto-find-package + (find-file dir) + (message nil)) + (message "'%s' does not exist.\nTry to build this package." + dir)))))) + +(defun guix-package-info-insert-misc (entry) + "Insert various buttons and other info for package ENTRY at point." + (if (guix-entry-value entry 'obsolete) + (guix-format-insert nil) + (let* ((entry-id (guix-entry-id entry)) + (package-id (or (guix-entry-value entry 'package-id) + entry-id)) + (full-name (guix-package-entry->name-specification entry)) + (store-path (guix-entry-value entry 'store-path))) + (guix-info-insert-title-simple "Package") + (if store-path + (guix-info-insert-value-indent store-path 'guix-file) + (guix-info-insert-action-button + "Show" + (lambda (btn) + (guix-package-info-show-store-path + (button-get btn 'entry-id) + (button-get btn 'package-id))) + "Show the store directory of the current package" + 'entry-id entry-id + 'package-id package-id)) + (when guix-package-info-button-functions + (insert "\n") + (guix-mapinsert (lambda (fun) + (funcall fun package-id full-name)) + guix-package-info-button-functions + (guix-info-get-indent) + :indent guix-info-indent + :column (guix-info-fill-column)))))) + +(defun guix-package-info-insert-build-button (id full-name) + "Insert button to build a package defined by ID." + (guix-info-insert-action-button + "Build" + (lambda (btn) + (guix-build-package (button-get btn 'id) + (format "Build '%s' package?" full-name))) + (format "Build the current package") + 'id id)) + +(defun guix-package-info-insert-build-log-button (id _name) + "Insert button to show build log of a package defined by ID." + (guix-info-insert-action-button + "Build Log" + (lambda (btn) + (guix-package-find-build-log (button-get btn 'id))) + "View build log of the current package" + 'id id)) + (defun guix-package-info-show-source (entry-id package-id) "Show file name of a package source in the current info buffer. Find the file if needed (see `guix-package-info-auto-find-source'). @@ -817,6 +917,7 @@ for all ARGS." (version format guix-output-info-insert-version) (output format guix-output-info-insert-output) (synopsis simple (indent guix-package-info-synopsis)) + guix-package-info-insert-misc (source simple guix-package-info-insert-source) (path simple (indent guix-file)) (dependencies simple (indent guix-file)) diff --git a/emacs/guix-utils.el b/emacs/guix-utils.el index ea9933f5c3..3e4ecc36ab 100644 --- a/emacs/guix-utils.el +++ b/emacs/guix-utils.el @@ -84,16 +84,33 @@ If FORMAT is non-nil, format VAL with FORMAT." (format format str) str)))) -(defun guix-mapinsert (function sequence separator) +(cl-defun guix-mapinsert (function sequence separator &key indent column) "Like `mapconcat' but for inserting text. Apply FUNCTION to each element of SEQUENCE, and insert SEPARATOR -at point between each FUNCTION call." - (when sequence - (funcall function (car sequence)) - (mapc (lambda (obj) - (insert separator) - (funcall function obj)) - (cdr sequence)))) +at point between each FUNCTION call. + +If INDENT is non-nil, it should be a number of spaces used to +indent each line of the inserted text. + +If COLUMN is non-nil, it should be a column number which +shouldn't be exceeded by the inserted text." + (pcase sequence + (`(,first . ,rest) + (let* ((indent (or indent 0)) + (max-column (and column (- column indent)))) + (guix-with-indent indent + (funcall function first) + (dolist (element rest) + (let ((before-sep-pos (and column (point)))) + (insert separator) + (let ((after-sep-pos (and column (point)))) + (funcall function element) + (when (and column + (> (current-column) max-column)) + (save-excursion + (delete-region before-sep-pos after-sep-pos) + (goto-char before-sep-pos) + (insert "\n"))))))))))) (defun guix-insert-button (label &optional type &rest properties) "Make button of TYPE with LABEL and insert it at point. diff --git a/emacs/local.mk b/emacs/local.mk index f83063cf5f..959ec2dd34 100644 --- a/emacs/local.mk +++ b/emacs/local.mk @@ -17,51 +17,51 @@ # You should have received a copy of the GNU General Public License # along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. -AUTOLOADS = emacs/guix-autoloads.el +AUTOLOADS = %D%/guix-autoloads.el ELFILES = \ - emacs/guix-about.el \ - emacs/guix-backend.el \ - emacs/guix-base.el \ - emacs/guix-build-log.el \ - emacs/guix-buffer.el \ - emacs/guix-command.el \ - emacs/guix-devel.el \ - emacs/guix-emacs.el \ - emacs/guix-entry.el \ - emacs/guix-external.el \ - emacs/guix-geiser.el \ - emacs/guix-guile.el \ - emacs/guix-help-vars.el \ - emacs/guix-history.el \ - emacs/guix-hydra.el \ - emacs/guix-hydra-build.el \ - emacs/guix-hydra-jobset.el \ - emacs/guix-info.el \ - emacs/guix-init.el \ - emacs/guix-license.el \ - emacs/guix-list.el \ - emacs/guix-location.el \ - emacs/guix-messages.el \ - emacs/guix-pcomplete.el \ - emacs/guix-popup.el \ - emacs/guix-prettify.el \ - emacs/guix-profiles.el \ - emacs/guix-read.el \ - emacs/guix-ui.el \ - emacs/guix-ui-license.el \ - emacs/guix-ui-location.el \ - emacs/guix-ui-package.el \ - emacs/guix-ui-generation.el \ - emacs/guix-ui-system-generation.el \ - emacs/guix-utils.el + %D%/guix-about.el \ + %D%/guix-backend.el \ + %D%/guix-base.el \ + %D%/guix-build-log.el \ + %D%/guix-buffer.el \ + %D%/guix-command.el \ + %D%/guix-devel.el \ + %D%/guix-emacs.el \ + %D%/guix-entry.el \ + %D%/guix-external.el \ + %D%/guix-geiser.el \ + %D%/guix-guile.el \ + %D%/guix-help-vars.el \ + %D%/guix-history.el \ + %D%/guix-hydra.el \ + %D%/guix-hydra-build.el \ + %D%/guix-hydra-jobset.el \ + %D%/guix-info.el \ + %D%/guix-init.el \ + %D%/guix-license.el \ + %D%/guix-list.el \ + %D%/guix-location.el \ + %D%/guix-messages.el \ + %D%/guix-pcomplete.el \ + %D%/guix-popup.el \ + %D%/guix-prettify.el \ + %D%/guix-profiles.el \ + %D%/guix-read.el \ + %D%/guix-ui.el \ + %D%/guix-ui-license.el \ + %D%/guix-ui-location.el \ + %D%/guix-ui-package.el \ + %D%/guix-ui-generation.el \ + %D%/guix-ui-system-generation.el \ + %D%/guix-utils.el if HAVE_EMACS dist_lisp_DATA = $(ELFILES) nodist_lisp_DATA = \ - emacs/guix-config.el \ + %D%/guix-config.el \ $(AUTOLOADS) $(AUTOLOADS): $(ELFILES) |