ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

emacs: Add "Source" field to 'guix-info' buffers.

Browse source 
Suggested by Ludovic Courtès.

* emacs/guix-info.el (guix-info-insert-methods, guix-info-displayed-params):
  Add 'source' parameter.
  (guix-package-info-source): New face.
  (guix-package-source): New button type.
  (guix-package-info-auto-find-source, guix-package-info-auto-download-source,
  guix-package-info-download-buffer): New variables.
  (guix-package-info-show-source, guix-package-info-insert-source-url,
  guix-package-info-insert-source, guix-package-info-download-source,
  guix-package-info-redisplay-after-download): New procedures.
* emacs/guix-base.el (guix-param-titles): Add 'source' parameter.
  (guix-operation-prompt): Add 'prompt' argument.
  (guix-after-source-download-hook): New variable.
  (guix-package-source-path, guix-package-source-build-derivation): New
  procedures.
* emacs/guix-main.scm (%package-param-alist): Add 'source' parameter.
  (package-source-names, package-source-derivation->store-path,
  package-source-path, package-source-build-derivation): New procedures.
This commit is contained in:
Alex Kost 2014-11-09 11:03:39 +03:00
parent dc05f01cba
commit 0b0fbf0c16
3 changed files with 204 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

33
emacs/guix-base.el
View file

@ -82,6 +82,7 @@ Interactively, prompt for PATH. With prefix, use
(id . "ID")
(name . "Name")
(version . "Version")
(source . "Source")
(license . "License")
(synopsis . "Synopsis")
(description . "Description")
@ -100,6 +101,7 @@ Interactively, prompt for PATH. With prefix, use
(id . "ID")
(name . "Name")
(version . "Version")
(source . "Source")
(license . "License")
(synopsis . "Synopsis")
(description . "Description")
@ -954,13 +956,14 @@ ENTRIES is a list of package entries to get info about packages."
strings)
(insert "\n")))
(defun guix-operation-prompt ()
(defun guix-operation-prompt (&optional prompt)
"Prompt a user for continuing the current operation.
Return non-nil, if the operation should be continued; nil otherwise."
Return non-nil, if the operation should be continued; nil otherwise.
Ask a user with PROMPT for continuing an operation."
(let* ((option-keys (mapcar #'guix-operation-option-key
guix-operation-options))
(keys (append '(?y ?n) option-keys))
(prompt (concat (propertize "Continue operation?"
(prompt (concat (propertize (or prompt "Continue operation?")
'face 'minibuffer-prompt)
" ("
(mapconcat
@ -1035,6 +1038,30 @@ Each element from GENERATIONS is a generation number."
'switch-to-generation profile generation)
operation-buffer)))
(defun guix-package-source-path (package-id)
"Return a store file path to a source of a package PACKAGE-ID."
(message "Calculating the source derivation ...")
(guix-eval-read
(guix-make-guile-expression
'package-source-path package-id)))
(defvar guix-after-source-download-hook nil
"Hook run after successful performing a 'source-download' operation.")
(defun guix-package-source-build-derivation (package-id &optional prompt)
"Build source derivation of a package PACKAGE-ID.
Ask a user with PROMPT for continuing an operation."
(when (or (not guix-operation-confirm)
(guix-operation-prompt (or prompt
"Build the source derivation?")))
(guix-eval-in-repl
(guix-make-guile-expression
'package-source-build-derivation
package-id
:use-substitutes? (or guix-use-substitutes 'f)
:dry-run? (or guix-dry-run 'f))
nil 'source-download)))
;;; Pull

130
emacs/guix-info.el
View file

@ -1,4 +1,4 @@
;;; guix-info.el --- Info buffers for displaying entries
;;; guix-info.el --- Info buffers for displaying entries -*- lexical-binding: t -*-
;; Copyright © 2014 Alex Kost <alezost@gmail.com>
@ -24,7 +24,6 @@
;;; Code:
(require 'guix-history)
(require 'guix-base)
(require 'guix-utils)
@ -107,6 +106,8 @@ number of characters, it will be split into several lines.")
guix-info-insert-title-simple)
(outputs guix-package-info-insert-outputs
guix-info-insert-title-simple)
(source guix-package-info-insert-source
guix-info-insert-title-simple)
(home-url guix-info-insert-url)
(inputs guix-package-info-insert-inputs)
(native-inputs guix-package-info-insert-native-inputs)
@ -121,6 +122,8 @@ number of characters, it will be split into several lines.")
(name guix-package-info-name)
(version guix-output-info-insert-version)
(output guix-output-info-insert-output)
(source guix-package-info-insert-source
guix-info-insert-title-simple)
(path guix-package-info-insert-output-path
guix-info-insert-title-simple)
(dependencies guix-package-info-insert-output-dependencies
@ -157,10 +160,11 @@ is a function, this function is called with parameter title as
argument.")
(defvar guix-info-displayed-params
'((package name version synopsis outputs location home-url
'((package name version synopsis outputs source location home-url
license inputs native-inputs propagated-inputs description)
(output name version output synopsis path dependencies location home-url
license inputs native-inputs propagated-inputs description)
(output name version output synopsis source path dependencies location
home-url license inputs native-inputs propagated-inputs
description)
(installed path dependencies)
(generation number prev-number current time path))
"List of displayed entry parameters.
@ -651,6 +655,122 @@ ENTRY is an alist with package info."
(defalias 'guix-package-info-insert-output-dependencies
'guix-package-info-insert-output-path)
;;; Inserting a source
(defface guix-package-info-source
'((t :inherit link :underline nil))
"Face used for a source URL of a package."
: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."
:type 'boolean
:group 'guix-package-info)
(defcustom guix-package-info-auto-download-source t
"If nil, do not automatically download a source file if it doesn't exist.
After pressing a \"Show\" button, a derivation of the package
source is calculated and a store file path is displayed. If this
variable is non-nil and the source file does not exist in the
store, it will be automatically downloaded (with a possible
prompt depending on `guix-operation-confirm' variable)."
:type 'boolean
:group 'guix-package-info)
(defvar guix-package-info-download-buffer nil
"Buffer from which a current download operation was performed.")
(define-button-type 'guix-package-source
:supertype 'guix
'face 'guix-package-info-source
'help-echo ""
'action (lambda (_)
;; As a source may not be a real URL (e.g., "mirror://..."),
;; no action is bound to a source button.
(message "Yes, this is the source URL. What did you expect?")))
(defun guix-package-info-insert-source-url (url &optional _)
"Make button from source URL and insert it at point."
(guix-insert-button url 'guix-package-source))
(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').
ENTRY-ID is an ID of the current entry (package or output).
PACKAGE-ID is an ID of the package which source to show."
(let* ((entry (guix-get-entry-by-id entry-id guix-entries))
(file (guix-package-source-path package-id)))
(or file
(error "Couldn't define file path of the package source"))
(let* ((new-entry (cons (cons 'source-file file)
entry))
(entries (cl-substitute-if
new-entry
(lambda (entry)
(equal (guix-get-key-val entry 'id)
entry-id))
guix-entries
:count 1)))
(guix-redisplay-buffer :entries entries)
(if (file-exists-p file)
(if guix-package-info-auto-find-source
(guix-find-file file)
(message "The source store path is displayed."))
(if guix-package-info-auto-download-source
(guix-package-info-download-source package-id)
(message "The source does not exist in the store."))))))
(defun guix-package-info-download-source (package-id)
"Download a source of the package PACKAGE-ID."
(setq guix-package-info-download-buffer (current-buffer))
(guix-package-source-build-derivation
package-id
"The source does not exist in the store. Download it?"))
(defun guix-package-info-insert-source (source entry)
"Insert SOURCE from package ENTRY at point.
SOURCE is a list of URLs."
(guix-info-insert-indent)
(if (null source)
(guix-format-insert nil)
(let* ((source-file (guix-get-key-val entry 'source-file))
(entry-id (guix-get-key-val entry 'id))
(package-id (or (guix-get-key-val entry 'package-id)
entry-id)))
(if (null source-file)
(guix-info-insert-action-button
"Show"
(lambda (btn)
(guix-package-info-show-source (button-get btn 'entry-id)
(button-get btn 'package-id)))
"Show the source store path of the current package"
'entry-id entry-id
'package-id package-id)
(unless (file-exists-p source-file)
(guix-info-insert-action-button
"Download"
(lambda (btn)
(guix-package-info-download-source
(button-get btn 'package-id)))
"Download the source into the store"
'package-id package-id))
(guix-info-insert-val-simple source-file
#'guix-info-insert-file-path))
(guix-info-insert-val-simple source
#'guix-package-info-insert-source-url))))
(defun guix-package-info-redisplay-after-download ()
"Redisplay an 'info' buffer after downloading the package source.
This function is used to hide a \"Download\" button if needed."
(when (buffer-live-p guix-package-info-download-buffer)
(guix-redisplay-buffer :buffer guix-package-info-download-buffer)
(setq guix-package-info-download-buffer nil)))
(add-hook 'guix-after-source-download-hook
'guix-package-info-redisplay-after-download)
;;; Displaying outputs

49
emacs/guix-main.scm
View file

@ -46,10 +46,12 @@
(ice-9 vlist)
(ice-9 match)
(srfi srfi-1)
(srfi srfi-2)
(srfi srfi-11)
(srfi srfi-19)
(srfi srfi-26)
(guix)
(guix git-download)
(guix packages)
(guix profiles)
(guix licenses)
@ -252,6 +254,18 @@ (define (package-license-names package)
(license-name license)))
(list-maybe (package-license package))))
(define (package-source-names package)
"Return a list of source names (URLs) of the PACKAGE."
(let ((source (package-source package)))
(and (origin? source)
(filter-map (lambda (uri)
(cond ((string? uri)
uri)
((git-reference? uri)
(git-reference-url uri))
(else "Unknown source type")))
(list-maybe (origin-uri source))))))
(define (package-unique? package)
"Return #t if PACKAGE is a single package with such name/version."
(null? (cdr (packages-by-name (package-name package)
@ -263,6 +277,7 @@ (define %package-param-alist
(name . ,package-name)
(version . ,package-version)
(license . ,package-license-names)
(source . ,package-source-names)
(synopsis . ,package-synopsis)
(description . ,package-description)
(home-url . ,package-home-page)
@ -867,3 +882,37 @@ (define (delete-generations* profile generations)
GENERATIONS is a list of generation numbers."
(with-store store
(delete-generations store profile generations)))
(define (package-source-derivation->store-path derivation)
"Return a store path of the package source DERIVATION."
(match (derivation-outputs derivation)
;; Source derivation is always (("out" . derivation)).
(((_ . output-drv))
(derivation-output-path output-drv))
(_ #f)))
(define (package-source-path package-id)
"Return a store file path to a source of a package PACKAGE-ID."
(and-let* ((package (package-by-id package-id))
(source (package-source package)))
(with-store store
(package-source-derivation->store-path
(package-source-derivation store source)))))
(define* (package-source-build-derivation package-id #:key dry-run?
(use-substitutes? #t))
"Build source derivation of a package PACKAGE-ID."
(and-let* ((package (package-by-id package-id))
(source (package-source package)))
(with-store store
(let* ((derivation (package-source-derivation store source))
(derivations (list derivation)))
(set-build-options store
#:use-substitutes? use-substitutes?)
(show-what-to-build store derivations
#:use-substitutes? use-substitutes?
#:dry-run? dry-run?)
(unless dry-run?
(build-derivations store derivations))
(format #t "The source store path: ~a~%"
(package-source-derivation->store-path derivation))))))