diff options
| -rw-r--r-- | doc/emacs.texi | 59 | ||||
| -rw-r--r-- | emacs/guix-base.el | 367 | ||||
| -rw-r--r-- | emacs/guix-info.el | 66 | ||||
| -rw-r--r-- | emacs/guix-list.el | 198 | ||||
| -rw-r--r-- | emacs/guix-main.scm | 882 | ||||
| -rw-r--r-- | emacs/guix.el | 38 | ||||
| -rw-r--r-- | gnu-system.am | 1 | ||||
| -rw-r--r-- | gnu/packages/crypto.scm | 6 | ||||
| -rw-r--r-- | gnu/packages/image.scm | 79 | ||||
| -rw-r--r-- | gnu/packages/scrot.scm | 68 |
10 files changed, 1214 insertions, 550 deletions
diff --git a/doc/emacs.texi b/doc/emacs.texi index 7616c8f92d..3c5698f571 100644 --- a/doc/emacs.texi +++ b/doc/emacs.texi @@ -104,6 +104,14 @@ many last generations. @end table +By default commands for displaying packages display each output on a +separate line. If you prefer to see a list of packages (i.e.@: a list +with a package per line), use the following setting: + +@example +(setq guix-package-list-type 'package) +@end example + It is possible to change the currently used profile with @kbd{M-x@tie{}guix-set-current-profile}. This has the same effect as specifying @code{--profile} option for @command{guix package} @@ -177,18 +185,15 @@ A ``package-list'' buffer additionally provides the following bindings: Describe marked packages (display available information in a ``package-info'' buffer). @item i -Mark "out" of the current package for installation (with prefix, prompt -for output(s) to install). +Mark the current package for installation. @item d -Mark all installed outputs of the current package for deletion (with -prefix, prompt for output(s) to delete). +Mark the current package for deletion. @item U -Mark all installed outputs of the current package for upgrading (with -prefix, prompt for output(s) to upgrade). +Mark the current package for upgrading. @item ^ Mark all obsolete packages for upgrading. @item x -Execute actions on marked packages. +Execute actions on the marked packages. @end table A ``generation-list'' buffer additionally provides the following @@ -244,6 +249,7 @@ all) and faces. @menu * Guile and Build Options: emacs Build Options. Specifying how packages are built. +* Buffer Names: emacs Buffer Names. Names of Guix buffers. * Keymaps: emacs Keymaps. Configuring key bindings. * Appearance: emacs Appearance. Settings for visual appearance. @end menu @@ -270,6 +276,39 @@ build}). @end table +@node emacs Buffer Names +@subsubsection Buffer Names + +Default names of ``guix.el'' buffers (``*Guix@tie{}@dots{}*'') may be +changed with the following variables: + +@table @code +@item guix-package-list-buffer-name +@item guix-output-list-buffer-name +@item guix-generation-list-buffer-name +@item guix-package-info-buffer-name +@item guix-output-info-buffer-name +@item guix-generation-info-buffer-name +@item guix-repl-buffer-name +@item guix-internal-repl-buffer-name +@item guix-temp-buffer-name +@end table + +For example if you want to display all types of results in a single +buffer (in such case you will probably use a history (@kbd{l}/@kbd{r}) +extensively), you may do it like this: + +@example +(let ((name "Guix Universal")) + (setq + guix-package-list-buffer-name name + guix-output-list-buffer-name name + guix-generation-list-buffer-name name + guix-package-info-buffer-name name + guix-output-info-buffer-name name + guix-generation-info-buffer-name name)) +@end example + @node emacs Keymaps @subsubsection Keymaps @@ -283,6 +322,9 @@ Parent keymap with general keys for ``list'' buffers. @item guix-package-list-mode-map Keymap with specific keys for ``package-list'' buffers. +@item guix-output-list-mode-map +Keymap with specific keys for ``output-list'' buffers. + @item guix-generation-list-mode-map Keymap with specific keys for ``generation-list'' buffers. @@ -292,6 +334,9 @@ Parent keymap with general keys for ``info'' buffers. @item guix-package-info-mode-map Keymap with specific keys for ``package-info'' buffers. +@item guix-output-info-mode-map +Keymap with specific keys for ``output-info'' buffers. + @item guix-generation-info-mode-map Keymap with specific keys for ``generation-info'' buffers. diff --git a/emacs/guix-base.el b/emacs/guix-base.el index 563df496cd..98ee315688 100644 --- a/emacs/guix-base.el +++ b/emacs/guix-base.el @@ -1,4 +1,4 @@ -;;; guix-base.el --- Common definitions +;;; guix-base.el --- Common definitions -*- lexical-binding: t -*- ;; Copyright © 2014 Alex Kost <alezost@gmail.com> @@ -87,6 +87,22 @@ Interactively, prompt for PATH. With prefix, use (path . "Installed path") (dependencies . "Dependencies") (output . "Output")) + (output + (id . "ID") + (name . "Name") + (version . "Version") + (license . "License") + (synopsis . "Synopsis") + (description . "Description") + (home-url . "Home page") + (output . "Output") + (inputs . "Inputs") + (native-inputs . "Native inputs") + (propagated-inputs . "Propagated inputs") + (location . "Location") + (installed . "Installed") + (path . "Installed path") + (dependencies . "Dependencies")) (generation (id . "ID") (number . "Number") @@ -130,6 +146,14 @@ Each element of the list has a form: (equal id (guix-get-key-val entry 'id))) entries)) +(defun guix-get-package-id-and-output-by-output-id (oid) + "Return list (PACKAGE-ID OUTPUT) by output id OID." + (cl-multiple-value-bind (pid-str output) + (split-string oid ":") + (let ((pid (string-to-number pid-str))) + (list (if (= 0 pid) pid-str pid) + output)))) + ;;; Location of the packages @@ -179,6 +203,14 @@ PARAM is a name of the entry parameter. VAL is a value of this parameter.") (put 'guix-entries 'permanent-local t) +(defvar-local guix-buffer-type nil + "Type of the current buffer.") +(put 'guix-buffer-type 'permanent-local t) + +(defvar-local guix-entry-type nil + "Type of the current entry.") +(put 'guix-entry-type 'permanent-local t) + (defvar-local guix-search-type nil "Type of the current search.") (put 'guix-search-type 'permanent-local t) @@ -187,48 +219,41 @@ VAL is a value of this parameter.") "Values of the current search.") (put 'guix-search-vals 'permanent-local t) -(defsubst guix-set-vars (entries search-type search-vals) - (setq guix-entries entries +(defsubst guix-set-vars (entries buffer-type entry-type + search-type search-vals) + (setq guix-entries entries + guix-buffer-type buffer-type + guix-entry-type entry-type guix-search-type search-type guix-search-vals search-vals)) -(defmacro guix-define-buffer-type (buf-type entry-type &rest args) - "Define common stuff for BUF-TYPE buffers for displaying entries. +(defun guix-get-symbol (postfix buffer-type &optional entry-type) + (intern (concat "guix-" + (when entry-type + (concat (symbol-name entry-type) "-")) + (symbol-name buffer-type) "-" postfix))) -ENTRY-TYPE is a type of displayed entries (see -`guix-get-entries'). +(defmacro guix-define-buffer-type (buf-type entry-type &rest args) + "Define common for BUF-TYPE buffers for displaying ENTRY-TYPE entries. In the text below TYPE means ENTRY-TYPE-BUF-TYPE. -This macro defines `guix-TYPE-mode', a custom group, several user -variables and the following functions: - - - `guix-TYPE-get-params-for-receiving' - - `guix-TYPE-revert' - - `guix-TYPE-redisplay' - - `guix-TYPE-make-history-item' - - `guix-TYPE-set' - - `guix-TYPE-show' - - `guix-TYPE-get-show' +This macro defines `guix-TYPE-mode', a custom group and several +user variables. The following stuff should be defined outside this macro: - `guix-BUF-TYPE-mode' - parent mode for the defined mode. - - `guix-BUF-TYPE-insert-entries' - function for inserting - entries in the current buffer; it is called with 2 arguments: - entries of the form of `guix-entries' and ENTRY-TYPE. - - - `guix-BUF-TYPE-get-displayed-params' - function returning a - list of parameters displayed in the current buffer; it is - called with ENTRY-TYPE as argument. - - `guix-TYPE-mode-initialize' (optional) - function for additional mode settings; it is called without arguments. Remaining argument (ARGS) should have a form [KEYWORD VALUE] ... The following keywords are available: + - `:buffer-name' - default value for the defined + `guix-TYPE-buffer-name' variable. + - `:required' - default value for the defined `guix-TYPE-required-params' variable. @@ -252,15 +277,9 @@ following keywords are available: (mode-init-fun (intern (concat prefix "-mode-initialize"))) (buf-name-var (intern (concat prefix "-buffer-name"))) (revert-var (intern (concat prefix "-revert-no-confirm"))) - (revert-fun (intern (concat prefix "-revert"))) - (redisplay-fun (intern (concat prefix "-redisplay"))) (history-var (intern (concat prefix "-history-size"))) - (history-fun (intern (concat prefix "-make-history-item"))) (params-var (intern (concat prefix "-required-params"))) - (params-fun (intern (concat prefix "-get-params-for-receiving"))) - (set-fun (intern (concat prefix "-set"))) - (show-fun (intern (concat prefix "-show"))) - (get-show-fun (intern (concat prefix "-get-show"))) + (buf-name-val (format "*Guix %s %s*" Entry-type-str Buf-type-str)) (revert-val nil) (history-val 20) (params-val '(id))) @@ -271,6 +290,7 @@ following keywords are available: (`:required (setq params-val (pop args))) (`:history-size (setq history-val (pop args))) (`:revert (setq revert-val (pop args))) + (`:buffer-name (setq buf-name-val (pop args))) (_ (pop args)))) `(progn @@ -279,8 +299,7 @@ following keywords are available: :prefix ,(concat prefix "-") :group ',(intern (concat "guix-" buf-type-str))) - (defcustom ,buf-name-var ,(format "*Guix %s %s*" - Entry-type-str Buf-type-str) + (defcustom ,buf-name-var ,buf-name-val ,(concat "Default name of the " buf-str " for displaying " entry-str ".") :type 'string :group ',group) @@ -309,7 +328,7 @@ following keywords are available: (define-derived-mode ,mode ,parent-mode ,(concat "Guix-" Buf-type-str) ,(concat "Major mode for displaying information about " entry-str ".\n\n" "\\{" mode-map-str "}") - (setq-local revert-buffer-function ',revert-fun) + (setq-local revert-buffer-function 'guix-revert-buffer) (setq-local guix-history-size ,history-var) (and (fboundp ',mode-init-fun) (,mode-init-fun))) @@ -317,88 +336,140 @@ following keywords are available: (define-key map (kbd "l") 'guix-history-back) (define-key map (kbd "r") 'guix-history-forward) (define-key map (kbd "g") 'revert-buffer) - (define-key map (kbd "R") ',redisplay-fun) - (define-key map (kbd "C-c C-z") 'guix-switch-to-repl)) - - (defun ,params-fun () - ,(concat "Return " entry-type-str " parameters that should be received.") - (unless (equal ,params-var 'all) - (cl-union ,params-var - (,(intern (concat "guix-" buf-type-str "-get-displayed-params")) - ',entry-type)))) - - (defun ,revert-fun (_ignore-auto noconfirm) - "Update information in the current buffer. + (define-key map (kbd "R") 'guix-redisplay-buffer) + (define-key map (kbd "C-c C-z") 'guix-switch-to-repl))))) + +(put 'guix-define-buffer-type 'lisp-indent-function 'defun) + + +;;; Getting info about packages and generations + +(defun guix-get-entries (entry-type search-type search-vals + &optional params) + "Search for entries of ENTRY-TYPE. + +Call an appropriate scheme function and return a list of the +form of `guix-entries'. + +ENTRY-TYPE should be one of the following symbols: `package', +`output' or `generation'. + +SEARCH-TYPE may be one of the following symbols: + +- If ENTRY-TYPE is `package' or `output': `id', `name', `regexp', + `all-available', `newest-available', `installed', `obsolete', + `generation'. + +- If ENTRY-TYPE is `generation': `id', `last', `all'. + +PARAMS is a list of parameters for receiving. If nil, get +information with all available parameters." + (guix-eval-read (guix-make-guile-expression + 'entries + guix-current-profile params + entry-type search-type search-vals))) + +(defun guix-get-show-entries (buffer-type entry-type search-type + &rest search-vals) + "Search for ENTRY-TYPE entries and show results in BUFFER-TYPE buffer. +See `guix-get-entries' for the meaning of SEARCH-TYPE and SEARCH-VALS." + (let ((entries (guix-get-entries entry-type search-type search-vals + (guix-get-params-for-receiving + buffer-type entry-type)))) + (guix-set-buffer entries buffer-type entry-type + search-type search-vals))) + +(defun guix-set-buffer (entries buffer-type entry-type search-type + search-vals &optional history-replace) + "Set up BUFFER-TYPE buffer for displaying ENTRY-TYPE ENTRIES. + +Display ENTRIES, set variables and make history item. +ENTRIES should have a form of `guix-entries'. + +See `guix-get-entries' for the meaning of SEARCH-TYPE and SEARCH-VALS. + +If HISTORY-REPLACE is non-nil, replace current history item, +otherwise add the new one." + (when entries + (let ((buf (if (eq major-mode (guix-get-symbol + "mode" buffer-type entry-type)) + (current-buffer) + (get-buffer-create + (symbol-value + (guix-get-symbol "buffer-name" + buffer-type entry-type)))))) + (with-current-buffer buf + (guix-show-entries entries buffer-type entry-type) + (guix-set-vars entries buffer-type entry-type + search-type search-vals) + (funcall (if history-replace + #'guix-history-replace + #'guix-history-add) + (guix-make-history-item))) + (pop-to-buffer buf + '((display-buffer-reuse-window + display-buffer-same-window))))) + (guix-result-message entries entry-type search-type search-vals)) + +(defun guix-show-entries (entries buffer-type entry-type) + "Display ENTRY-TYPE ENTRIES in the current BUFFER-TYPE buffer." + (let ((inhibit-read-only t)) + (erase-buffer) + (funcall (symbol-function (guix-get-symbol + "mode" buffer-type entry-type))) + (funcall (guix-get-symbol "insert-entries" buffer-type) + entries entry-type) + (goto-char (point-min)))) + +(defun guix-history-call (entries buffer-type entry-type + search-type search-vals) + "Function called for moving by history." + (guix-show-entries entries buffer-type entry-type) + (guix-set-vars entries buffer-type entry-type + search-type search-vals) + (guix-result-message entries entry-type search-type search-vals)) + +(defun guix-make-history-item () + "Make and return a history item for the current buffer." + (list #'guix-history-call + guix-entries guix-buffer-type guix-entry-type + guix-search-type guix-search-vals)) + +(defun guix-get-params-for-receiving (buffer-type entry-type) + "Return parameters that should be received for BUFFER-TYPE, ENTRY-TYPE." + (let* ((required-var (guix-get-symbol "required-params" + buffer-type entry-type)) + (required (symbol-value required-var))) + (unless (equal required 'all) + (cl-union required + (funcall (guix-get-symbol "get-displayed-params" + buffer-type) + entry-type))))) + +(defun guix-revert-buffer (_ignore-auto noconfirm) + "Update information in the current buffer. The function is suitable for `revert-buffer-function'. See `revert-buffer' for the meaning of NOCONFIRM." - (when (or ,revert-var - noconfirm - (y-or-n-p "Update current information? ")) - (let ((entries (guix-get-entries ',entry-type guix-search-type - guix-search-vals (,params-fun)))) - (,set-fun entries guix-search-type guix-search-vals t)))) - - (defun ,redisplay-fun () - "Redisplay current information. + (when (or noconfirm + (symbol-value + (guix-get-symbol "revert-no-confirm" + guix-buffer-type guix-entry-type)) + (y-or-n-p "Update current information? ")) + (let ((entries (guix-get-entries + guix-entry-type guix-search-type guix-search-vals + (guix-get-params-for-receiving guix-buffer-type + guix-entry-type)))) + (guix-set-buffer entries guix-buffer-type guix-entry-type + guix-search-type guix-search-vals t)))) + +(defun guix-redisplay-buffer () + "Redisplay current information. This function will not update the information, use \"\\[revert-buffer]\" if you want the full update." - (interactive) - (,show-fun guix-entries) - (guix-result-message guix-entries ',entry-type - guix-search-type guix-search-vals)) - - (defun ,history-fun () - "Make and return a history item for the current buffer." - (list (lambda (entries search-type search-vals) - (,show-fun entries) - (guix-set-vars entries search-type search-vals) - (guix-result-message entries ',entry-type - search-type search-vals)) - guix-entries guix-search-type guix-search-vals)) - - (defun ,set-fun (entries search-type search-vals &optional history-replace) - ,(concat "Set up the " buf-str " for displaying " entry-str ".\n\n" - "Display ENTRIES, set variables and make history item.\n\n" - "ENTRIES should have a form of `guix-entries'.\n\n" - "See `guix-get-entries' for the meaning of SEARCH-TYPE and\n" - "SEARCH-VALS.\n\n" - "If HISTORY-REPLACE is non-nil, replace current history item,\n" - "otherwise add the new one.") - (when entries - (let ((buf (if (eq major-mode ',mode) - (current-buffer) - (get-buffer-create ,buf-name-var)))) - (with-current-buffer buf - (,show-fun entries) - (guix-set-vars entries search-type search-vals) - (funcall (if history-replace - #'guix-history-replace - #'guix-history-add) - (,history-fun))) - (pop-to-buffer buf - '((display-buffer-reuse-window - display-buffer-same-window))))) - (guix-result-message entries ',entry-type - search-type search-vals)) - - (defun ,show-fun (entries) - ,(concat "Display " entry-type-str " ENTRIES in the current " buf-str ".") - (let ((inhibit-read-only t)) - (erase-buffer) - (,mode) - (,(intern (concat "guix-" buf-type-str "-insert-entries")) - entries ',entry-type) - (goto-char (point-min)))) - - (defun ,get-show-fun (search-type &rest search-vals) - ,(concat "Search for " entry-str " and show results in the " buf-str ".\n" - "See `guix-get-entries' for the meaning of SEARCH-TYPE and\n" - "SEARCH-VALS.") - (let ((entries (guix-get-entries ',entry-type search-type - search-vals (,params-fun)))) - (,set-fun entries search-type search-vals)))))) - -(put 'guix-define-buffer-type 'lisp-indent-function 'defun) + (interactive) + (guix-show-entries guix-entries guix-buffer-type guix-entry-type) + (guix-result-message guix-entries guix-entry-type + guix-search-type guix-search-vals)) ;;; Messages @@ -427,8 +498,8 @@ This function will not update the information, use (many "%d newest available packages." count)) (installed (0 "No installed packages.") - (1 "A single installed package.") - (many "%d installed packages." count)) + (1 "A single package installed.") + (many "%d packages installed." count)) (obsolete (0 "No obsolete packages.") (1 "A single obsolete package.") @@ -437,6 +508,39 @@ This function will not update the information, use (0 "No packages installed in generation %d." val) (1 "A single package installed in generation %d." val) (many "%d packages installed in generation %d." count val))) + (output + (id + (0 "Package outputs not found.") + (1 "") + (many "%d package outputs." count)) + (name + (0 "The package output '%s' not found." val) + (1 "A single package output with name '%s'." val) + (many "%d package outputs with '%s' name." count val)) + (regexp + (0 "No package outputs matching '%s'." val) + (1 "A single package output matching '%s'." val) + (many "%d package outputs matching '%s'." count val)) + (all-available + (0 "No package outputs are available for some reason.") + (1 "A single available package output (that's strange).") + (many "%d available package outputs." count)) + (newest-available + (0 "No package outputs are available for some reason.") + (1 "A single newest available package output (that's strange).") + (many "%d newest available package outputs." count)) + (installed + (0 "No installed package outputs.") + (1 "A single package output installed.") + (many "%d package outputs installed." count)) + (obsolete + (0 "No obsolete package outputs.") + (1 "A single obsolete package output.") + (many "%d obsolete package outputs." count)) + (generation + (0 "No package outputs installed in generation %d." val) + (1 "A single package output installed in generation %d." val) + (many "%d package outputs installed in generation %d." count val))) (generation (id (0 "Generations not found.") @@ -467,33 +571,6 @@ This function will not update the information, use (apply #'message format args))) -;;; Getting info about packages and generations - -(defun guix-get-entries (entry-type search-type search-vals &optional params) - "Search for entries of ENTRY-TYPE. - -Call an appropriate scheme function and return a list of the -form of `guix-entries'. - -ENTRY-TYPE should be one of the following symbols: `package' or -`generation'. - -SEARCH-TYPE may be one of the following symbols: - -- If ENTRY-TYPE is `package': `id', `name', `regexp', - `all-available', `newest-available', `installed', `obsolete', - `generation'. - -- If ENTRY-TYPE is `generation': `id', `last', `all'. - -PARAMS is a list of parameters for receiving. If nil, get -information with all available parameters." - (guix-eval-read (guix-make-guile-expression - 'get-entries - guix-current-profile params - entry-type search-type search-vals))) - - ;;; Actions on packages and generations (defcustom guix-operation-confirm t @@ -547,9 +624,9 @@ See `guix-process-package-actions' for details." (or (null guix-operation-confirm) (let* ((entries (guix-get-entries 'package 'id - (list (append (mapcar #'car install) - (mapcar #'car upgrade) - (mapcar #'car remove))) + (append (mapcar #'car install) + (mapcar #'car upgrade) + (mapcar #'car remove)) '(id name version location))) (install-strings (guix-get-package-strings install entries)) (upgrade-strings (guix-get-package-strings upgrade entries)) diff --git a/emacs/guix-info.el b/emacs/guix-info.el index 687a15eefa..f9c17b2d13 100644 --- a/emacs/guix-info.el +++ b/emacs/guix-info.el @@ -117,6 +117,23 @@ number of characters, it will be split into several lines.") guix-info-insert-title-simple) (dependencies guix-package-info-insert-output-dependencies guix-info-insert-title-simple)) + (output + (name guix-package-info-name) + (version guix-output-info-insert-version) + (output guix-output-info-insert-output) + (path guix-package-info-insert-output-path + guix-info-insert-title-simple) + (dependencies guix-package-info-insert-output-dependencies + guix-info-insert-title-simple) + (license guix-package-info-license) + (synopsis guix-package-info-synopsis) + (description guix-package-info-insert-description + 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) + (propagated-inputs guix-package-info-insert-propagated-inputs) + (location guix-package-info-insert-location)) (generation (number guix-generation-info-insert-number) (path guix-info-insert-file-path) @@ -141,6 +158,8 @@ argument.") (defvar guix-info-displayed-params '((package name version synopsis outputs 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) (installed path dependencies) (generation number prev-number time path)) "List of displayed entry parameters. @@ -427,7 +446,8 @@ Propertize package button with FACE." (guix-insert-button name face (lambda (btn) - (guix-package-info-get-show 'name (button-label btn))) + (guix-get-show-entries 'info 'package 'name + (button-label btn))) "Describe this package")) @@ -511,16 +531,46 @@ ENTRY is an alist with package info." (button-get btn 'output))))) (concat type-str " '" full-name "'") 'action-type type - 'id (guix-get-key-val entry 'id) + 'id (or (guix-get-key-val entry 'package-id) + (guix-get-key-val entry 'id)) 'output output))) (defun guix-package-info-insert-output-path (path &optional _) "Insert PATH of the installed output." (guix-info-insert-val-simple path #'guix-info-insert-file-path)) -(defun guix-package-info-insert-output-dependencies (deps &optional _) - "Insert dependencies DEPS of the installed output." - (guix-info-insert-val-simple deps #'guix-info-insert-file-path)) +(defalias 'guix-package-info-insert-output-dependencies + 'guix-package-info-insert-output-path) + + +;;; Displaying outputs + +(guix-define-buffer-type info output + :buffer-name "*Guix Package Info*" + :required (id package-id installed non-unique)) + +(defun guix-output-info-insert-version (version entry) + "Insert output VERSION and obsolete text if needed at point." + (guix-info-insert-val-default version + 'guix-package-info-version) + (and (guix-get-key-val entry 'obsolete) + (guix-package-info-insert-obsolete-text))) + +(defun guix-output-info-insert-output (output entry) + "Insert OUTPUT and action buttons at point." + (let* ((installed (guix-get-key-val entry 'installed)) + (obsolete (guix-get-key-val entry 'obsolete)) + (action-type (if installed 'delete 'install))) + (guix-info-insert-val-default + output + (if installed + 'guix-package-info-installed-outputs + 'guix-package-info-uninstalled-outputs)) + (guix-info-insert-indent) + (guix-package-info-insert-action-button action-type entry output) + (when obsolete + (guix-info-insert-indent) + (guix-package-info-insert-action-button 'upgrade entry output)))) ;;; Displaying generations @@ -532,8 +582,6 @@ ENTRY is an alist with package info." "Face used for a number of a generation." :group 'guix-generation-info) -(declare-function guix-package-list-get-show "guix-list" t t) - (defun guix-generation-info-insert-number (number &optional _) "Insert generation NUMBER and action buttons." (guix-info-insert-val-default number 'guix-generation-info-number) @@ -541,8 +589,8 @@ ENTRY is an alist with package info." (guix-info-insert-action-button "Packages" (lambda (btn) - (guix-package-list-get-show 'generation - (button-get btn 'number))) + (guix-get-show-entries 'list 'package 'generation + (button-get btn 'number))) "Show installed packages for this generation" 'number number) (guix-info-insert-indent) diff --git a/emacs/guix-list.el b/emacs/guix-list.el index 8d9b231dd1..3342175fe3 100644 --- a/emacs/guix-list.el +++ b/emacs/guix-list.el @@ -55,6 +55,12 @@ entries, he will be prompted for confirmation." (outputs 13 t) (installed 13 t) (synopsis 30 nil)) + (output + (name 20 t) + (version 10 nil) + (output 9 t) + (installed 12 t) + (synopsis 30 nil)) (generation (number 5 ,(lambda (a b) (guix-list-sort-numerically 0 a b)) @@ -82,6 +88,10 @@ this list have a priority.") (synopsis . guix-list-get-one-line) (description . guix-list-get-one-line) (installed . guix-package-list-get-installed-outputs)) + (output + (name . guix-package-list-get-name) + (synopsis . guix-list-get-one-line) + (description . guix-list-get-one-line)) (generation (time . guix-list-get-time) (path . guix-list-get-file-path))) @@ -343,6 +353,7 @@ Same as `tabulated-list-sort', but also restore marks after sorting." (defvar guix-list-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent map tabulated-list-mode-map) + (define-key map (kbd "RET") 'guix-list-describe) (define-key map (kbd "m") 'guix-list-mark) (define-key map (kbd "*") 'guix-list-mark) (define-key map (kbd "M") 'guix-list-mark-all) @@ -371,16 +382,12 @@ following keywords are available: This macro defines the following functions: - - `guix-ENTRY-TYPE-describe' - display marked entries in info buffer. - - `guix-ENTRY-TYPE-mark-MARK-NAME' functions for each mark specified in `:marks' argument." (let* ((entry-type-str (symbol-name entry-type)) - (entry-str (concat entry-type-str " entries")) (prefix (concat "guix-" entry-type-str "-list")) (mode-str (concat prefix "-mode")) (init-fun (intern (concat prefix "-mode-initialize"))) - (describe-fun (intern (concat prefix "-describe"))) (marks-var (intern (concat prefix "-mark-alist"))) (marks-val nil) (sort-key nil) @@ -409,22 +416,6 @@ This macro defines the following functions: (guix-list-mark ',mark-name t)))) marks-val) - (defun ,describe-fun (&optional arg) - ,(concat "Describe " entry-str " marked with a general mark.\n" - "If no entry is marked, describe the current " entry-type-str ".\n" - "With prefix (if ARG is non-nil), describe the " entry-str "\n" - "marked with any mark.") - (interactive "P") - (let* ((ids (or (apply #'guix-list-get-marked-id-list - (unless arg '(general))) - (list (guix-list-current-id)))) - (count (length ids))) - (when (or (<= count guix-list-describe-warning-count) - (y-or-n-p (format "Do you really want to describe %d entries? " - count))) - (,(intern (concat "guix-" entry-type-str "-info-get-show")) - 'id ids)))) - (defun ,init-fun () ,(concat "Initial settings for `" mode-str "'.") ,(when sort-key @@ -439,6 +430,24 @@ This macro defines the following functions: (put 'guix-list-define-entry-type 'lisp-indent-function 'defun) +(defun guix-list-describe-maybe (entry-type ids) + "Describe ENTRY-TYPE entries in info buffer using list of IDS." + (let ((count (length ids))) + (when (or (<= count guix-list-describe-warning-count) + (y-or-n-p (format "Do you really want to describe %d entries? " + count))) + (apply #'guix-get-show-entries 'info entry-type 'id ids)))) + +(defun guix-list-describe (&optional arg) + "Describe entries marked with a general mark. +If no entries are marked, describe the current entry. +With prefix (if ARG is non-nil), describe entries marked with any mark." + (interactive "P") + (let ((ids (or (apply #'guix-list-get-marked-id-list + (unless arg '(general))) + (list (guix-list-current-id))))) + (guix-list-describe-maybe guix-entry-type ids))) + ;;; Displaying packages @@ -460,6 +469,15 @@ This macro defines the following functions: "Face used if a package is obsolete." :group 'guix-package-list) +(defcustom guix-package-list-type 'output + "Define how to display packages in a list buffer. +May be a symbol `package' or `output' (if `output', display each +output on a separate line; if `package', display each package on +a separate line)." + :type '(choice (const :tag "List of packages" package) + (const :tag "List of outputs" output)) + :group 'guix-package-list) + (defcustom guix-package-list-generation-marking-enabled nil "If non-nil, allow putting marks in a list with 'generation packages'. @@ -477,7 +495,6 @@ likely)." :group 'guix-package-list) (let ((map guix-package-list-mode-map)) - (define-key map (kbd "RET") 'guix-package-list-describe) (define-key map (kbd "x") 'guix-package-list-execute) (define-key map (kbd "i") 'guix-package-list-mark-install) (define-key map (kbd "d") 'guix-package-list-mark-delete) @@ -504,7 +521,8 @@ Colorize it with `guix-package-list-installed' or (defun guix-package-list-marking-check () "Signal an error if marking is disabled for the current buffer." (when (and (not guix-package-list-generation-marking-enabled) - (derived-mode-p 'guix-package-list-mode) + (or (derived-mode-p 'guix-package-list-mode) + (derived-mode-p 'guix-output-list-mode)) (eq guix-search-type 'generation)) (error "Action marks are disabled for lists of 'generation packages'"))) @@ -568,9 +586,10 @@ be separated with \",\")." (and arg "Output(s) to upgrade: ") installed)))) -(defun guix-package-list-mark-upgrades () - "Mark all obsolete packages for upgrading." - (interactive) +(defun guix-list-mark-package-upgrades (fun) + "Mark all obsolete packages for upgrading. +Use FUN to perform marking of the current line. FUN should +accept an entry as argument." (guix-package-list-marking-check) (let ((obsolete (cl-remove-if-not (lambda (entry) @@ -584,20 +603,32 @@ be separated with \",\")." (equal id (guix-get-key-val entry 'id))) obsolete))) (when entry - (apply #'guix-list-mark - 'upgrade nil - (guix-get-installed-outputs entry)))))))) + (funcall fun entry))))))) -(defun guix-package-list-execute () - "Perform actions on the marked packages." +(defun guix-package-list-mark-upgrades () + "Mark all obsolete packages for upgrading." (interactive) + (guix-list-mark-package-upgrades + (lambda (entry) + (apply #'guix-list-mark + 'upgrade nil + (guix-get-installed-outputs entry))))) + +(defun guix-list-execute-package-actions (fun) + "Perform actions on the marked packages. +Use FUN to define actions suitable for `guix-process-package-actions'. +FUN should accept action-type as argument." (let ((actions (delq nil - (mapcar #'guix-package-list-make-action - '(install delete upgrade))))) + (mapcar fun '(install delete upgrade))))) (if actions (apply #'guix-process-package-actions actions) (user-error "No operations specified")))) +(defun guix-package-list-execute () + "Perform actions on the marked packages." + (interactive) + (guix-list-execute-package-actions #'guix-package-list-make-action)) + (defun guix-package-list-make-action (action-type) "Return action specification for the packages marked with ACTION-TYPE. Return nil, if there are no packages marked with ACTION-TYPE. @@ -606,6 +637,104 @@ The specification is suitable for `guix-process-package-actions'." (and specs (cons action-type specs)))) +;;; Displaying outputs + +(guix-define-buffer-type list output + :buffer-name "*Guix Package List*") + +(guix-list-define-entry-type output + :sort-key name + :marks ((install . ?I) + (upgrade . ?U) + (delete . ?D))) + +(defcustom guix-output-list-describe-type 'package + "Define how to describe outputs in a list buffer. +May be a symbol `package' or `output' (if `output', describe only +marked outputs; if `package', describe all outputs of the marked +packages)." + :type '(choice (const :tag "Describe packages" package) + (const :tag "Describe outputs" output)) + :group 'guix-output-list) + +(let ((map guix-output-list-mode-map)) + (define-key map (kbd "RET") 'guix-output-list-describe) + (define-key map (kbd "x") 'guix-output-list-execute) + (define-key map (kbd "i") 'guix-output-list-mark-install) + (define-key map (kbd "d") 'guix-output-list-mark-delete) + (define-key map (kbd "U") 'guix-output-list-mark-upgrade) + (define-key map (kbd "^") 'guix-output-list-mark-upgrades)) + +(defun guix-output-list-mark-install () + "Mark the current output for installation and move to the next line." + (interactive) + (guix-package-list-marking-check) + (let* ((entry (guix-list-current-entry)) + (installed (guix-get-key-val entry 'installed))) + (if installed + (user-error "This output is already installed") + (guix-list-mark 'install t)))) + +(defun guix-output-list-mark-delete () + "Mark the current output for deletion and move to the next line." + (interactive) + (guix-package-list-marking-check) + (let* ((entry (guix-list-current-entry)) + (installed (guix-get-key-val entry 'installed))) + (if installed + (guix-list-mark 'delete t) + (user-error "This output is not installed")))) + +(defun guix-output-list-mark-upgrade () + "Mark the current output for deletion and move to the next line." + (interactive) + (guix-package-list-marking-check) + (let* ((entry (guix-list-current-entry)) + (installed (guix-get-key-val entry 'installed))) + (or installed + (user-error "This output is not installed")) + (when (or (guix-get-key-val entry 'obsolete) + (y-or-n-p "This output is not obsolete. Try to upgrade it anyway? ")) + (guix-list-mark 'upgrade t)))) + +(defun guix-output-list-mark-upgrades () + "Mark all obsolete package outputs for upgrading." + (interactive) + (guix-list-mark-package-upgrades + (lambda (_) (guix-list-mark 'upgrade)))) + +(defun guix-output-list-execute () + "Perform actions on the marked outputs." + (interactive) + (guix-list-execute-package-actions #'guix-output-list-make-action)) + +(defun guix-output-list-make-action (action-type) + "Return action specification for the outputs marked with ACTION-TYPE. +Return nil, if there are no outputs marked with ACTION-TYPE. +The specification is suitable for `guix-process-output-actions'." + (let ((ids (guix-list-get-marked-id-list action-type))) + (and ids (cons action-type + (mapcar #'guix-get-package-id-and-output-by-output-id + ids))))) + +(defun guix-output-list-describe (&optional arg) + "Describe outputs or packages marked with a general mark. +If no entries are marked, describe the current output or package. +With prefix (if ARG is non-nil), describe entries marked with any mark. +Also see `guix-output-list-describe-type'." + (interactive "P") + (if (eq guix-output-list-describe-type 'output) + (guix-list-describe arg) + (let* ((oids (or (apply #'guix-list-get-marked-id-list + (unless arg '(general))) + (list (guix-list-current-id)))) + (pids (mapcar (lambda (oid) + (car (guix-get-package-id-and-output-by-output-id + oid))) + oids))) + (guix-list-describe-maybe 'package (cl-remove-duplicates pids))))) + + ;;; Displaying generations (guix-define-buffer-type list generation) @@ -617,13 +746,14 @@ The specification is suitable for `guix-process-package-actions'." (let ((map guix-generation-list-mode-map)) (define-key map (kbd "RET") 'guix-generation-list-show-packages) - (define-key map (kbd "i") 'guix-generation-list-describe) + (define-key map (kbd "i") 'guix-list-describe) (define-key map (kbd "d") 'guix-generation-list-mark-delete-simple)) (defun guix-generation-list-show-packages () "List installed packages for the generation at point." (interactive) - (guix-package-list-get-show 'generation (guix-list-current-id))) + (guix-get-show-entries 'list guix-package-list-type 'generation + (guix-list-current-id))) (provide 'guix-list) diff --git a/emacs/guix-main.scm b/emacs/guix-main.scm index 1383d08830..273a360dfc 100644 --- a/emacs/guix-main.scm +++ b/emacs/guix-main.scm @@ -20,17 +20,9 @@ ;; Information about packages and generations is passed to the elisp ;; side in the form of alists of parameters (such as ‘name’ or -;; ‘version’) and their values. These alists are called "entries" in -;; this code. So to distinguish, just "package" in the name of a -;; function means a guile object ("package" record) while -;; "package entry" means alist of package parameters and values (see -;; ‘package-param-alist’). -;; -;; "Entry" is probably not the best name for such alists, because there -;; already exists "manifest-entry" which has nothing to do with the -;; "entry" described above. Do not be confused :) +;; ‘version’) and their values. -;; ‘get-entries’ function is the “entry point” for the elisp side to get +;; ‘entries’ procedure is the “entry point” for the elisp side to get ;; information about packages and generations. ;; Since name/version pair is not necessarily unique, we use @@ -43,10 +35,6 @@ ;; Important: as object addresses live only during guile session, elisp ;; part should take care about updating information after "Guix REPL" is ;; restarted (TODO!) -;; -;; ‘installed’ parameter of a package entry contains information about -;; installed outputs. It is a list of "installed entries" (see -;; ‘package-installed-param-alist’). ;; To speed-up the process of getting information, the following ;; auxiliary variables are used: @@ -55,10 +43,6 @@ ;; ;; - `%package-table' - Hash table of ;; "name+version key"/"list of packages" pairs. -;; -;; - `%current-manifest-entries-table' - Hash table of -;; "name+version key"/"list of manifest entries" pairs. This variable -;; is set by `set-current-manifest-maybe!' when it is needed. ;;; Code: @@ -82,6 +66,9 @@ (and (not (null? lst)) (first lst))) +(define (list-maybe obj) + (if (list? obj) obj (list obj))) + (define full-name->name+version package-name->name+version) (define (name+version->full-name name version) (string-append name "-" version)) @@ -97,9 +84,6 @@ (define name+version->key cons) (define key->name+version car+cdr) -(define %current-manifest #f) -(define %current-manifest-entries-table #f) - (define %packages (fold-packages (lambda (pkg res) (vhash-consq (object-address pkg) pkg res)) @@ -119,139 +103,113 @@ %packages) table)) -;; FIXME get rid of this function! -(define (set-current-manifest-maybe! profile) - (define (manifest-entries->hash-table entries) - (let ((entries-table (make-hash-table (length entries)))) - (for-each (lambda (entry) - (let* ((key (name+version->key - (manifest-entry-name entry) - (manifest-entry-version entry))) - (ref (hash-ref entries-table key))) - (hash-set! entries-table key - (if ref (cons entry ref) (list entry))))) - entries) - entries-table)) - - (when profile - (let ((manifest (profile-manifest profile))) - (unless (and (manifest? %current-manifest) - (equal? manifest %current-manifest)) - (set! %current-manifest manifest) - (set! %current-manifest-entries-table - (manifest-entries->hash-table - (manifest-entries manifest))))))) - -(define (manifest-entries-by-name+version name version) - (or (hash-ref %current-manifest-entries-table - (name+version->key name version)) - '())) - -(define (packages-by-name+version name version) - (or (hash-ref %package-table - (name+version->key name version)) - '())) - -(define (packages-by-full-name full-name) - (call-with-values - (lambda () (full-name->name+version full-name)) - packages-by-name+version)) - -(define (package-by-address address) - (and=> (vhash-assq address %packages) - cdr)) - -(define (packages-by-id id) - (if (integer? id) - (let ((pkg (package-by-address id))) - (if pkg (list pkg) '())) - (packages-by-full-name id))) - -(define (package-by-id id) - (first-or-false (packages-by-id id))) - -(define (newest-package-by-id id) - (and=> (id->name+version id) - (lambda (name) - (first-or-false (find-best-packages-by-name name #f))))) - -(define (id->name+version id) - (if (integer? id) - (and=> (package-by-address id) - (lambda (pkg) - (values (package-name pkg) - (package-version pkg)))) - (full-name->name+version id))) +(define (manifest-entry->name+version+output entry) + (values + (manifest-entry-name entry) + (manifest-entry-version entry) + (manifest-entry-output entry))) + +(define (manifest-entries->hash-table entries) + "Return a hash table of name keys and lists of matching manifest ENTRIES." + (let ((table (make-hash-table (length entries)))) + (for-each (lambda (entry) + (let* ((key (manifest-entry-name entry)) + (ref (hash-ref table key))) + (hash-set! table key + (if ref (cons entry ref) (list entry))))) + entries) + table)) -(define (fold-manifest-entries proc init) - "Fold over `%current-manifest-entries-table'. -Call (PROC NAME VERSION ENTRIES RESULT) for each element of the hash -table, using INIT as the initial value of RESULT." - (hash-fold (lambda (key entries res) - (let-values (((name version) (key->name+version key))) - (proc name version entries res))) +(define (manifest=? m1 m2) + (or (eq? m1 m2) + (equal? m1 m2))) + +(define manifest->hash-table + (let ((current-manifest #f) + (current-table #f)) + (lambda (manifest) + "Return a hash table of name keys and matching MANIFEST entries." + (unless (manifest=? manifest current-manifest) + (set! current-manifest manifest) + (set! current-table (manifest-entries->hash-table + (manifest-entries manifest)))) + current-table))) + +(define* (manifest-entries-by-name manifest name #:optional version output) + "Return a list of MANIFEST entries matching NAME, VERSION and OUTPUT." + (let ((entries (or (hash-ref (manifest->hash-table manifest) name) + '()))) + (if (or version output) + (filter (lambda (entry) + (and (or (not version) + (equal? version (manifest-entry-version entry))) + (or (not output) + (equal? output (manifest-entry-output entry))))) + entries) + entries))) + +(define (manifest-entry-by-output entries output) + "Return a manifest entry from ENTRIES matching OUTPUT." + (find (lambda (entry) + (string= output (manifest-entry-output entry))) + entries)) + +(define (fold-manifest-by-name manifest proc init) + "Fold over MANIFEST entries. +Call (PROC NAME VERSION ENTRIES RESULT), using INIT as the initial value +of RESULT. ENTRIES is a list of manifest entries with NAME/VERSION." + (hash-fold (lambda (name entries res) + (proc name (manifest-entry-version (car entries)) + entries res)) init - %current-manifest-entries-table)) - -(define (fold-object proc init obj) - (fold proc init - (if (list? obj) obj (list obj)))) + (manifest->hash-table manifest))) (define* (object-transformer param-alist #:optional (params '())) - "Return function for transforming an object into alist of parameters/values. + "Return procedure transforming objects into alist of parameter/value pairs. -PARAM-ALIST is alist of available object parameters (symbols) and functions -returning values of these parameters. Each function is called with object as -a single argument. +PARAM-ALIST is alist of available parameters (symbols) and procedures +returning values of these parameters. Each procedure is applied to +objects. -PARAMS is list of parameters from PARAM-ALIST that should be returned by a -resulting function. If PARAMS is not specified or is an empty list, use all -available parameters. +PARAMS is list of parameters from PARAM-ALIST that should be returned by +a resulting procedure. If PARAMS is not specified or is an empty list, +use all available parameters. Example: - (let ((alist `((plus1 . ,1+) (minus1 . ,1-) (mul2 . ,(cut * 2 <>)))) - (number->alist (object-transformer alist '(plus1 mul2)))) + (let* ((alist `((plus1 . ,1+) (minus1 . ,1-) (mul2 . ,(cut * 2 <>)))) + (number->alist (object-transformer alist '(plus1 mul2)))) (number->alist 8)) => ((plus1 . 9) (mul2 . 16)) " - (let ((alist (let ((use-all-params (null? params))) - (filter-map (match-lambda - ((param . fun) - (and (or use-all-params - (memq param params)) - (cons param fun))) - (_ #f)) - param-alist)))) - (lambda (object) + (let* ((use-all-params (null? params)) + (alist (filter-map (match-lambda + ((param . proc) + (and (or use-all-params + (memq param params)) + (cons param proc))) + (_ #f)) + param-alist))) + (lambda objects (map (match-lambda - ((param . fun) - (cons param (fun object)))) + ((param . proc) + (cons param (apply proc objects)))) alist)))) -(define package-installed-param-alist - (list - (cons 'output manifest-entry-output) - (cons 'path manifest-entry-item) - (cons 'dependencies manifest-entry-dependencies))) - -(define manifest-entry->installed-entry - (object-transformer package-installed-param-alist)) +(define %manifest-entry-param-alist + `((output . ,manifest-entry-output) + (path . ,manifest-entry-item) + (dependencies . ,manifest-entry-dependencies))) -(define (manifest-entries->installed-entries entries) - (map manifest-entry->installed-entry entries)) +(define manifest-entry->sexp + (object-transformer %manifest-entry-param-alist)) -(define (installed-entries-by-name+version name version) - (manifest-entries->installed-entries - (manifest-entries-by-name+version name version))) - -(define (installed-entries-by-package package) - (installed-entries-by-name+version (package-name package) - (package-version package))) +(define (manifest-entries->sexps entries) + (map manifest-entry->sexp entries)) (define (package-inputs-names inputs) - "Return list of full names of the packages from package INPUTS." + "Return a list of full names of the packages from package INPUTS." (filter-map (match-lambda ((_ (? package? package)) (package-full-name package)) @@ -259,90 +217,113 @@ Example: inputs)) (define (package-license-names package) - "Return list of license names of the PACKAGE." - (fold-object (lambda (license res) - (if (license? license) - (cons (license-name license) res) - res)) - '() - (package-license package))) + "Return a list of license names of the PACKAGE." + (filter-map (lambda (license) + (and (license? license) + (license-name license))) + (list-maybe (package-license package)))) (define (package-unique? package) "Return #t if PACKAGE is a single package with such name/version." - (null? (cdr (packages-by-name+version (package-name package) - (package-version package))))) - -(define package-param-alist - (list - (cons 'id object-address) - (cons 'name package-name) - (cons 'version package-version) - (cons 'license package-license-names) - (cons 'synopsis package-synopsis) - (cons 'description package-description) - (cons 'home-url package-home-page) - (cons 'outputs package-outputs) - (cons 'non-unique (negate package-unique?)) - (cons 'inputs (lambda (pkg) (package-inputs-names - (package-inputs pkg)))) - (cons 'native-inputs (lambda (pkg) (package-inputs-names - (package-native-inputs pkg)))) - (cons 'propagated-inputs (lambda (pkg) (package-inputs-names - (package-propagated-inputs pkg)))) - (cons 'location (lambda (pkg) (location->string - (package-location pkg)))) - (cons 'installed installed-entries-by-package))) + (null? (cdr (packages-by-name (package-name package) + (package-version package))))) + +(define %package-param-alist + `((id . ,object-address) + (package-id . ,object-address) + (name . ,package-name) + (version . ,package-version) + (license . ,package-license-names) + (synopsis . ,package-synopsis) + (description . ,package-description) + (home-url . ,package-home-page) + (outputs . ,package-outputs) + (non-unique . ,(negate package-unique?)) + (inputs . ,(lambda (pkg) + (package-inputs-names + (package-inputs pkg)))) + (native-inputs . ,(lambda (pkg) + (package-inputs-names + (package-native-inputs pkg)))) + (propagated-inputs . ,(lambda (pkg) + (package-inputs-names + (package-propagated-inputs pkg)))) + (location . ,(lambda (pkg) + (location->string (package-location pkg)))))) (define (package-param package param) - "Return the value of a PACKAGE PARAM." - (define (accessor param) - (and=> (assq param package-param-alist) - cdr)) - (and=> (accessor param) + "Return a value of a PACKAGE PARAM." + (and=> (assq-ref %package-param-alist param) (cut <> package))) -(define (matching-package-entries ->entry predicate) - "Return list of package entries for the matching packages. -PREDICATE is called on each package." + +;;; Finding packages. + +(define (package-by-address address) + (and=> (vhash-assq address %packages) + cdr)) + +(define (packages-by-name+version name version) + (or (hash-ref %package-table + (name+version->key name version)) + '())) + +(define (packages-by-full-name full-name) + (call-with-values + (lambda () (full-name->name+version full-name)) + packages-by-name+version)) + +(define (packages-by-id id) + (if (integer? id) + (let ((pkg (package-by-address id))) + (if pkg (list pkg) '())) + (packages-by-full-name id))) + +(define (id->name+version id) + (if (integer? id) + (and=> (package-by-address id) + (lambda (pkg) + (values (package-name pkg) + (package-version pkg)))) + (full-name->name+version id))) + +(define (package-by-id id) + (first-or-false (packages-by-id id))) + +(define (newest-package-by-id id) + (and=> (id->name+version id) + (lambda (name) + (first-or-false (find-best-packages-by-name name #f))))) + +(define (matching-packages predicate) (fold-packages (lambda (pkg res) (if (predicate pkg) - (cons (->entry pkg) res) + (cons pkg res) res)) '())) -(define (make-obsolete-package-entry name version entries) - "Return package entry for an obsolete package with NAME and VERSION. -ENTRIES is a list of manifest entries used to get installed info." - `((id . ,(name+version->full-name name version)) - (name . ,name) - (version . ,version) - (outputs . ,(map manifest-entry-output entries)) - (obsolete . #t) - (installed . ,(manifest-entries->installed-entries entries)))) - -(define (package-entries-by-name+version ->entry name version) - "Return list of package entries for packages with NAME and VERSION." - (let ((packages (packages-by-name+version name version))) - (if (null? packages) - (let ((entries (manifest-entries-by-name+version name version))) - (if (null? entries) - '() - (list (make-obsolete-package-entry name version entries)))) - (map ->entry packages)))) +(define (filter-packages-by-output packages output) + (filter (lambda (package) + (member output (package-outputs package))) + packages)) + +(define* (packages-by-name name #:optional version output) + "Return a list of packages matching NAME, VERSION and OUTPUT." + (let ((packages (if version + (packages-by-name+version name version) + (matching-packages + (lambda (pkg) (string=? name (package-name pkg))))))) + (if output + (filter-packages-by-output packages output) + packages))) -(define (package-entries-by-spec profile ->entry spec) - "Return list of package entries for packages with name specification SPEC." - (set-current-manifest-maybe! profile) - (let-values (((name version) - (full-name->name+version spec))) - (if version - (package-entries-by-name+version ->entry name version) - (matching-package-entries - ->entry - (lambda (pkg) (string=? name (package-name pkg))))))) +(define (manifest-entry->packages entry) + (call-with-values + (lambda () (manifest-entry->name+version+output entry)) + packages-by-name)) -(define (package-entries-by-regexp profile ->entry regexp match-params) - "Return list of package entries for packages matching REGEXP string. +(define (packages-by-regexp regexp match-params) + "Return a list of packages matching REGEXP string. MATCH-PARAMS is a list of parameters that REGEXP can match." (define (package-match? package regexp) (any (lambda (param) @@ -350,88 +331,311 @@ MATCH-PARAMS is a list of parameters that REGEXP can match." (and (string? val) (regexp-exec regexp val)))) match-params)) - (set-current-manifest-maybe! profile) (let ((re (make-regexp regexp regexp/icase))) - (matching-package-entries ->entry (cut package-match? <> re)))) - -(define (package-entries-by-ids profile ->entry ids) - "Return list of package entries for packages matching KEYS. -IDS may be an object-address, a full-name or a list of such elements." - (set-current-manifest-maybe! profile) - (fold-object - (lambda (id res) - (if (integer? id) - (let ((pkg (package-by-address id))) - (if pkg - (cons (->entry pkg) res) - res)) - (let ((entries (package-entries-by-spec #f ->entry id))) - (if (null? entries) - res - (append res entries))))) - '() - ids)) - -(define (newest-available-package-entries profile ->entry) - "Return list of package entries for the newest available packages." - (set-current-manifest-maybe! profile) + (matching-packages (cut package-match? <> re)))) + +(define (all-available-packages) + "Return a list of all available packages." + (matching-packages (const #t))) + +(define (newest-available-packages) + "Return a list of the newest available packages." (vhash-fold (lambda (name elem res) (match elem - ((version newest pkgs ...) - (cons (->entry newest) res)))) + ((_ newest pkgs ...) + (cons newest res)))) '() (find-newest-available-packages))) -(define (all-available-package-entries profile ->entry) - "Return list of package entries for all available packages." - (set-current-manifest-maybe! profile) - (matching-package-entries ->entry (const #t))) + +;;; Making package/output patterns. + +(define (specification->package-pattern specification) + (call-with-values + (lambda () + (full-name->name+version specification)) + list)) -(define (manifest-package-entries ->entry) - "Return list of package entries for the current manifest." - (fold-manifest-entries - (lambda (name version entries res) - ;; We don't care about duplicates for the list of - ;; installed packages, so just take any package (car) - ;; matching name+version - (cons (car (package-entries-by-name+version ->entry name version)) - res)) - '())) +(define (specification->output-pattern specification) + (call-with-values + (lambda () + (package-specification->name+version+output specification #f)) + list)) -(define (installed-package-entries profile ->entry) - "Return list of package entries for all installed packages." - (set-current-manifest-maybe! profile) - (manifest-package-entries ->entry)) - -(define (generation-package-entries profile ->entry generation) - "Return list of package entries for packages from GENERATION." - (set-current-manifest-maybe! - (generation-file-name profile generation)) - (manifest-package-entries ->entry)) - -(define (obsolete-package-entries profile _) - "Return list of package entries for obsolete packages." - (set-current-manifest-maybe! profile) - (fold-manifest-entries +(define (id->package-pattern id) + (if (integer? id) + (package-by-address id) + (specification->package-pattern id))) + +(define (id->output-pattern id) + "Return an output pattern by output ID. +ID should be '<package-address>:<output>' or '<name>-<version>:<output>'." + (let-values (((name version output) + (package-specification->name+version+output id))) + (if version + (list name version output) + (list (package-by-address (string->number name)) + output)))) + +(define (specifications->package-patterns . specifications) + (map specification->package-pattern specifications)) + +(define (specifications->output-patterns . specifications) + (map specification->output-pattern specifications)) + +(define (ids->package-patterns . ids) + (map id->package-pattern ids)) + +(define (ids->output-patterns . ids) + (map id->output-pattern ids)) + +(define* (manifest-patterns-result packages res obsolete-pattern + #:optional installed-pattern) + "Auxiliary procedure for 'manifest-package-patterns' and +'manifest-output-patterns'." + (if (null? packages) + (cons (obsolete-pattern) res) + (if installed-pattern + ;; We don't need duplicates for a list of installed packages, + ;; so just take any (car) package. + (cons (installed-pattern (car packages)) res) + res))) + +(define* (manifest-package-patterns manifest #:optional obsolete-only?) + "Return a list of package patterns for MANIFEST entries. +If OBSOLETE-ONLY? is #f, use all entries, otherwise make patterns only +for obsolete packages." + (fold-manifest-by-name + manifest (lambda (name version entries res) - (let ((packages (packages-by-name+version name version))) - (if (null? packages) - (cons (make-obsolete-package-entry name version entries) res) - res))) + (manifest-patterns-result (packages-by-name name version) + res + (lambda () (list name version entries)) + (and (not obsolete-only?) + (cut list <> entries)))) '())) +(define* (manifest-output-patterns manifest #:optional obsolete-only?) + "Return a list of output patterns for MANIFEST entries. +If OBSOLETE-ONLY? is #f, use all entries, otherwise make patterns only +for obsolete packages." + (fold (lambda (entry res) + (manifest-patterns-result (manifest-entry->packages entry) + res + (lambda () entry) + (and (not obsolete-only?) + (cut list <> entry)))) + '() + (manifest-entries manifest))) + +(define (obsolete-package-patterns manifest) + (manifest-package-patterns manifest #t)) + +(define (obsolete-output-patterns manifest) + (manifest-output-patterns manifest #t)) + -;;; Generation entries +;;; Transforming package/output patterns into alists. -(define (profile-generations profile) - "Return list of generations for PROFILE." - (let ((generations (generation-numbers profile))) - (if (equal? generations '(0)) - '() - generations))) +(define (obsolete-package-sexp name version entries) + "Return an alist with information about obsolete package. +ENTRIES is a list of installed manifest entries." + `((id . ,(name+version->full-name name version)) + (name . ,name) + (version . ,version) + (outputs . ,(map manifest-entry-output entries)) + (obsolete . #t) + (installed . ,(manifest-entries->sexps entries)))) + +(define (package-pattern-transformer manifest params) + "Return 'package-pattern->package-sexps' procedure." + (define package->sexp + (object-transformer %package-param-alist params)) + + (define* (sexp-by-package package #:optional + (entries (manifest-entries-by-name + manifest + (package-name package) + (package-version package)))) + (cons (cons 'installed (manifest-entries->sexps entries)) + (package->sexp package))) + + (define (->sexps pattern) + (match pattern + ((? package? package) + (list (sexp-by-package package))) + (((? package? package) entries) + (list (sexp-by-package package entries))) + ((name version entries) + (list (obsolete-package-sexp + name version entries))) + ((name version) + (let ((packages (packages-by-name name version))) + (if (null? packages) + (let ((entries (manifest-entries-by-name + manifest name version))) + (if (null? entries) + '() + (list (obsolete-package-sexp + name version entries)))) + (map sexp-by-package packages)))))) + + ->sexps) + +(define (output-pattern-transformer manifest params) + "Return 'output-pattern->output-sexps' procedure." + (define package->sexp + (object-transformer (alist-delete 'id %package-param-alist) + params)) + + (define manifest-entry->sexp + (object-transformer (alist-delete 'output %manifest-entry-param-alist) + params)) + + (define* (output-sexp pkg-alist pkg-address output + #:optional entry) + (let ((entry-alist (if entry + (manifest-entry->sexp entry) + '())) + (base `((id . ,(string-append + (number->string pkg-address) + ":" output)) + (output . ,output) + (installed . ,(->bool entry))))) + (append entry-alist base pkg-alist))) + + (define (obsolete-output-sexp entry) + (let-values (((name version output) + (manifest-entry->name+version+output entry))) + (let ((base `((id . ,(make-package-specification + name version output)) + (package-id . ,(name+version->full-name name version)) + (name . ,name) + (version . ,version) + (output . ,output) + (obsolete . #t) + (installed . #t)))) + (append (manifest-entry->sexp entry) base)))) + + (define* (sexps-by-package package #:optional output + (entries (manifest-entries-by-name + manifest + (package-name package) + (package-version package)))) + ;; Assuming that PACKAGE has this OUTPUT. + (let ((pkg-alist (package->sexp package)) + (address (object-address package)) + (outputs (if output + (list output) + (package-outputs package)))) + (map (lambda (output) + (output-sexp pkg-alist address output + (manifest-entry-by-output entries output))) + outputs))) + + (define* (sexps-by-manifest-entry entry #:optional + (packages (manifest-entry->packages + entry))) + (if (null? packages) + (list (obsolete-output-sexp entry)) + (map (lambda (package) + (output-sexp (package->sexp package) + (object-address package) + (manifest-entry-output entry) + entry)) + packages))) + + (define (->sexps pattern) + (match pattern + ((? package? package) + (sexps-by-package package)) + ((package (? string? output)) + (sexps-by-package package output)) + ((? manifest-entry? entry) + (list (obsolete-output-sexp entry))) + ((package entry) + (sexps-by-manifest-entry entry (list package))) + ((name version output) + (let ((packages (packages-by-name name version output))) + (if (null? packages) + (let ((entries (manifest-entries-by-name + manifest name version output))) + (append-map (cut sexps-by-manifest-entry <>) + entries)) + (append-map (cut sexps-by-package <> output) + packages)))))) + + ->sexps) + +(define (entry-type-error entry-type) + (error (format #f "Wrong entry-type '~a'" entry-type))) + +(define (search-type-error entry-type search-type) + (error (format #f "Wrong search type '~a' for entry-type '~a'" + search-type entry-type))) + +(define %pattern-transformers + `((package . ,package-pattern-transformer) + (output . ,output-pattern-transformer))) + +(define (pattern-transformer entry-type) + (assq-ref %pattern-transformers entry-type)) + +;; All procedures from inner alists are called with (MANIFEST . SEARCH-VALS) +;; as arguments; see `package/output-sexps'. +(define %patterns-makers + (let* ((apply-to-rest (lambda (proc) + (lambda (_ . rest) (apply proc rest)))) + (apply-to-first (lambda (proc) + (lambda (first . _) (proc first)))) + (manifest-package-proc (apply-to-first manifest-package-patterns)) + (manifest-output-proc (apply-to-first manifest-output-patterns)) + (regexp-proc (lambda (_ regexp params . __) + (packages-by-regexp regexp params))) + (all-proc (lambda _ (all-available-packages))) + (newest-proc (lambda _ (newest-available-packages)))) + `((package + (id . ,(apply-to-rest ids->package-patterns)) + (name . ,(apply-to-rest specifications->package-patterns)) + (installed . ,manifest-package-proc) + (generation . ,manifest-package-proc) + (obsolete . ,(apply-to-first obsolete-package-patterns)) + (regexp . ,regexp-proc) + (all-available . ,all-proc) + (newest-available . ,newest-proc)) + (output + (id . ,(apply-to-rest ids->output-patterns)) + (name . ,(apply-to-rest specifications->output-patterns)) + (installed . ,manifest-output-proc) + (generation . ,manifest-output-proc) + (obsolete . ,(apply-to-first obsolete-output-patterns)) + (regexp . ,regexp-proc) + (all-available . ,all-proc) + (newest-available . ,newest-proc))))) + +(define (patterns-maker entry-type search-type) + (or (and=> (assq-ref %patterns-makers entry-type) + (cut assq-ref <> search-type)) + (search-type-error entry-type search-type))) + +(define (package/output-sexps profile params entry-type + search-type search-vals) + "Return information about packages or package outputs. +See 'entry-sexps' for details." + (let* ((profile (if (eq? search-type 'generation) + (generation-file-name profile (car search-vals)) + profile)) + (manifest (profile-manifest profile)) + (patterns (apply (patterns-maker entry-type search-type) + manifest search-vals)) + (->sexps ((pattern-transformer entry-type) manifest params))) + (append-map ->sexps patterns))) + + +;;; Getting information about generations. (define (generation-param-alist profile) - "Return alist of generation parameters and functions for PROFILE." + "Return an alist of generation parameters and procedures for PROFILE." (list (cons 'id identity) (cons 'number identity) @@ -440,77 +644,86 @@ IDS may be an object-address, a full-name or a list of such elements." (cons 'time (lambda (gen) (time-second (generation-time profile gen)))))) -(define (matching-generation-entries profile ->entry predicate) - "Return list of generation entries for the matching generations. -PREDICATE is called on each generation." - (filter-map (lambda (gen) - (and (predicate gen) (->entry gen))) - (profile-generations profile))) +(define (matching-generations profile predicate) + "Return a list of PROFILE generations matching PREDICATE." + (filter predicate (profile-generations profile))) -(define (last-generation-entries profile ->entry number) - "Return list of last NUMBER generation entries. -If NUMBER is 0 or less, return all generation entries." +(define (last-generations profile number) + "Return a list of last NUMBER generations. +If NUMBER is 0 or less, return all generations." (let ((generations (profile-generations profile)) (number (if (<= number 0) +inf.0 number))) - (map ->entry - (if (> (length generations) number) - (list-head (reverse generations) number) - generations)))) - -(define (all-generation-entries profile ->entry) - "Return list of all generation entries." - (last-generation-entries profile ->entry +inf.0)) + (if (> (length generations) number) + (list-head (reverse generations) number) + generations))) -(define (generation-entries-by-ids profile ->entry ids) - "Return list of generation entries for generations matching IDS. -IDS is a list of generation numbers." - (matching-generation-entries profile ->entry (cut memq <> ids))) +(define (find-generations profile search-type search-vals) + "Find PROFILE's generations matching SEARCH-TYPE and SEARCH-VALS." + (case search-type + ((id) + (matching-generations profile (cut memq <> (car search-vals)))) + ((last) + (last-generations profile (car search-vals))) + ((all) + (last-generations profile +inf.0)) + (else (search-type-error "generation" search-type)))) + +(define (generation-sexps profile params search-type search-vals) + "Return information about generations. +See 'entry-sexps' for details." + (let ((generations (find-generations profile search-type search-vals)) + (->sexp (object-transformer (generation-param-alist profile) + params))) + (map ->sexp generations))) -;;; Getting package/generation entries - -(define %package-entries-functions - (alist->vhash - `((id . ,package-entries-by-ids) - (name . ,package-entries-by-spec) - (regexp . ,package-entries-by-regexp) - (all-available . ,all-available-package-entries) - (newest-available . ,newest-available-package-entries) - (installed . ,installed-package-entries) - (obsolete . ,obsolete-package-entries) - (generation . ,generation-package-entries)) - hashq)) - -(define %generation-entries-functions - (alist->vhash - `((id . ,generation-entries-by-ids) - (last . ,last-generation-entries) - (all . ,all-generation-entries)) - hashq)) - -(define (get-entries profile params entry-type search-type search-vals) - "Return list of entries. -ENTRY-TYPE and SEARCH-TYPE define a search function that should be -applied to PARAMS and VALS." - (let-values (((vhash ->entry) - (case entry-type - ((package) - (values %package-entries-functions - (object-transformer - package-param-alist params))) - ((generation) - (values %generation-entries-functions - (object-transformer - (generation-param-alist profile) params))) - (else (format (current-error-port) - "Wrong entry type '~a'" entry-type))))) - (match (vhash-assq search-type vhash) - ((key . fun) - (apply fun profile ->entry search-vals)) - (_ '())))) +;;; Getting package/output/generation entries (alists). + +(define (entries profile params entry-type search-type search-vals) + "Return information about entries. + +ENTRY-TYPE is a symbol defining a type of returning information. Should +be: 'package', 'output' or 'generation'. + +SEARCH-TYPE and SEARCH-VALS define how to get the information. +SEARCH-TYPE should be one of the following symbols: + +- If ENTRY-TYPE is 'package' or 'output': + 'id', 'name', 'regexp', 'all-available', 'newest-available', + 'installed', 'obsolete', 'generation'. + +- If ENTRY-TYPE is 'generation': + 'id', 'last', 'all'. + +PARAMS is a list of parameters for receiving. If it is an empty list, +get information with all available parameters, which are: + +- If ENTRY-TYPE is 'package': + 'id', 'name', 'version', 'outputs', 'license', 'synopsis', + 'description', 'home-url', 'inputs', 'native-inputs', + 'propagated-inputs', 'location', 'installed'. + +- If ENTRY-TYPE is 'output': + 'id', 'package-id', 'name', 'version', 'output', 'license', + 'synopsis', 'description', 'home-url', 'inputs', 'native-inputs', + 'propagated-inputs', 'location', 'installed', 'path', 'dependencies'. + +- If ENTRY-TYPE is 'generation': + 'id', 'number', 'prev-number', 'path', 'time'. + +Returning value is a list of alists. Each alist consists of +parameter/value pairs." + (case entry-type + ((package output) + (package/output-sexps profile params entry-type + search-type search-vals)) + ((generation) + (generation-sexps profile params + search-type search-vals)) + (else (entry-type-error entry-type)))) -;;; Actions +;;; Package actions. (define* (package->manifest-entry* package #:optional output) (and package @@ -600,4 +813,3 @@ OUTPUTS is a list of package outputs (may be an empty list)." "~a packages in profile~%" count) count))))))))) - diff --git a/emacs/guix.el b/emacs/guix.el index 7336f6732e..f6e2023ea5 100644 --- a/emacs/guix.el +++ b/emacs/guix.el @@ -28,6 +28,7 @@ ;;; Code: +(require 'guix-base) (require 'guix-list) (require 'guix-info) @@ -42,12 +43,6 @@ If nil, show a single package in the info buffer." :type 'boolean :group 'guix) -(defcustom guix-show-generations-function 'guix-generation-list-get-show - "Default function used to display generations." - :type '(choice (function-item guix-generation-list-get-show) - (function-item guix-generation-info-get-show)) - :group 'guix) - (defvar guix-search-params '(name synopsis description) "Default list of package parameters for searching by regexp.") @@ -62,22 +57,31 @@ SEARCH-VALS. Results are displayed in the list buffer, unless a single package is found and `guix-list-single-package' is nil." - (let* ((list-params (guix-package-list-get-params-for-receiving)) - (packages (guix-get-entries 'package search-type - search-vals list-params))) + (let* ((list-params (guix-get-params-for-receiving + 'list guix-package-list-type)) + (packages (guix-get-entries guix-package-list-type + search-type search-vals + list-params))) (if (or guix-list-single-package (cdr packages)) - (guix-package-list-set packages search-type search-vals) - (let ((info-params (guix-package-info-get-params-for-receiving))) - (unless (equal list-params info-params) - ;; If we don't have required info, we should receive it again - (setq packages (guix-get-entries 'package search-type - search-vals info-params)))) - (guix-package-info-set packages search-type search-vals)))) + (guix-set-buffer packages 'list guix-package-list-type + search-type search-vals) + (let* ((info-params (guix-get-params-for-receiving + 'info guix-package-list-type)) + (packages (if (equal list-params info-params) + packages + ;; If we don't have required info, we should + ;; receive it again + (guix-get-entries guix-package-list-type + search-type search-vals + info-params)))) + (guix-set-buffer packages 'info guix-package-list-type + search-type search-vals))))) (defun guix-get-show-generations (search-type &rest search-vals) "Search for generations and show results." - (apply guix-show-generations-function search-type search-vals)) + (apply #'guix-get-show-entries + 'list 'generation search-type search-vals)) ;;;###autoload (defun guix-search-by-name (name) diff --git a/gnu-system.am b/gnu-system.am index 7d6a6b99a7..e774f5053d 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -218,6 +218,7 @@ GNU_SYSTEM_MODULES = \ gnu/packages/samba.scm \ gnu/packages/scheme.scm \ gnu/packages/screen.scm \ + gnu/packages/scrot.scm \ gnu/packages/sdl.scm \ gnu/packages/search.scm \ gnu/packages/serveez.scm \ diff --git a/gnu/packages/crypto.scm b/gnu/packages/crypto.scm index e78afb62d6..5fbc0cf857 100644 --- a/gnu/packages/crypto.scm +++ b/gnu/packages/crypto.scm @@ -26,7 +26,7 @@ (define-public libsodium (package (name "libsodium") - (version "0.5.0") + (version "1.0.0") (source (origin (method url-fetch) (uri (string-append @@ -34,11 +34,11 @@ version ".tar.gz")) (sha256 (base32 - "1w7rrnsvhhzhywrr3nhlhppv4kqzdszz3dwy8jrsv8lrj5hs181w")))) + "19f9vf0shfp4rc4l791r6xjg06z4i8psj1zkjkm3z5b640yzxlff")))) (build-system gnu-build-system) (synopsis "Portable NaCl-based crypto library") (description "libsodium is a new easy-to-use high-speed software library for network communication, encryption, decryption, signatures, etc.") (license isc) - (home-page "https://github.com/jedisct1/libsodium"))) ; No real homepage + (home-page "http://libsodium.org"))) diff --git a/gnu/packages/image.scm b/gnu/packages/image.scm index 981d3a8976..0e79942f19 100644 --- a/gnu/packages/image.scm +++ b/gnu/packages/image.scm @@ -23,6 +23,8 @@ #:use-module (gnu packages pkg-config) #:use-module (gnu packages xml) #:use-module (gnu packages ghostscript) ;lcms + #:use-module (gnu packages xorg) + #:use-module (gnu packages giflib) #:use-module ((guix licenses) #:prefix license:) #:use-module (guix packages) #:use-module (guix download) @@ -213,3 +215,80 @@ an indexing tool useful for the JPIP protocol, JPWL-tools for error-resilience, a Java-viewer for j2k-images, ...") (home-page "http://jbig2dec.sourceforge.net/") (license license:bsd-2))) + +(define-public imlib2 + (package + (name "imlib2") + (version "1.4.6") + (source (origin + (method url-fetch) + (uri (string-append + "mirror://sourceforge/enlightenment/imlib2-" + version ".tar.gz")) + (sha256 + (base32 + "0kjggg4gfn6chi8v1xddd5qwk1fbnl7rvd93qiclv5v11s615k0p")))) + (build-system gnu-build-system) + (arguments + '(;; Will be fixed in the next release: + ;; <http://git.enlightenment.org/legacy/imlib2.git/commit/?id=5dde234b2d3caf067ea827858c53adc5d4c56c13>. + #:phases (alist-cons-before + 'configure 'patch-config + (lambda _ + (substitute* "imlib2-config.in" + (("@my_libs@") ""))) + %standard-phases))) + (native-inputs + `(("pkgconfig" ,pkg-config))) + (inputs + `(("libx11" ,libx11) + ("libxext" ,libxext) + ("freetype" ,freetype) + ("libjpeg" ,libjpeg) + ("libpng" ,libpng) + ("libtiff" ,libtiff) + ("giflib" ,giflib) + ("bzip2" ,bzip2))) + (home-page "http://sourceforge.net/projects/enlightenment/") + (synopsis + "Loading, saving, rendering and manipulating image files") + (description + "Imlib2 is a library that does image file loading and saving as well as +rendering, manipulation, arbitrary polygon support, etc. + +It does ALL of these operations FAST. Imlib2 also tries to be highly +intelligent about doing them, so writing naive programs can be done easily, +without sacrificing speed. + +This is a complete rewrite over the Imlib 1.x series. The architecture is +more modular, simple, and flexible.") + ;; This license adds several sentences to the original X11 license. + (license (license:x11-style "file://COPYING" + "See 'COPYING' in the distribution.")))) + +(define-public giblib + (package + (name "giblib") + (version "1.2.4") + (source (origin + (method url-fetch) + (uri (string-append + "http://linuxbrit.co.uk/downloads/giblib-" + version ".tar.gz")) + (sha256 + (base32 + "1b4bmbmj52glq0s898lppkpzxlprq9aav49r06j2wx4dv3212rhp")))) + (build-system gnu-build-system) + (inputs + `(("libx11" ,libx11) + ("imlib2" ,imlib2))) + (home-page "http://linuxbrit.co.uk/software/") ; no real home-page + (synopsis "Wrapper library for imlib2") + (description + "giblib is a simple library which wraps imlib2's context API, avoiding +all the context_get/set calls, adds fontstyles to the truetype renderer and +supplies a generic doubly-linked list and some string functions.") + ;; This license removes a clause about X Consortium from the original + ;; X11 license. + (license (license:x11-style "file://COPYING" + "See 'COPYING' in the distribution.")))) diff --git a/gnu/packages/scrot.scm b/gnu/packages/scrot.scm new file mode 100644 index 0000000000..a5bbe187bd --- /dev/null +++ b/gnu/packages/scrot.scm @@ -0,0 +1,68 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 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 GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (gnu packages scrot) + #:use-module (guix packages) + #:use-module (guix download) + #:use-module (guix build-system gnu) + #:use-module (guix licenses) + #:use-module (gnu packages xorg) + #:use-module (gnu packages image)) + +(define-public scrot + (package + (name "scrot") + (version "0.8") + (source (origin + (method url-fetch) + (uri (string-append + "http://linuxbrit.co.uk/downloads/scrot-" + version ".tar.gz")) + (sha256 + (base32 + "1wll744rhb49lvr2zs6m93rdmiq59zm344jzqvijrdn24ksiqgb1")))) + (build-system gnu-build-system) + (arguments + ;; By default, man and doc are put in PREFIX/{man,doc} instead of + ;; PREFIX/share/{man,doc}. + '(#:configure-flags + (list (string-append "--mandir=" + (assoc-ref %outputs "out") + "/share/man")) + #:phases (alist-replace + 'install + (lambda* (#:key inputs outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (doc (string-append out "/share/doc/scrot"))) + (mkdir-p doc) + (zero? + (system* "make" "install" + (string-append "docsdir=" doc))))) + %standard-phases))) + (inputs + `(("libx11" ,libx11) + ("giblib" ,giblib))) + (home-page "http://linuxbrit.co.uk/software/") + (synopsis "Command-line screen capture utility for X Window System") + (description + "scrot allows to save a screenshot of a full screen, a window or a part +of the screen selected by mouse.") + ;; This license removes a clause about X Consortium from the original + ;; X11 license. + (license (x11-style "file://COPYING" + "See 'COPYING' in the distribution.")))) |