diff options
| -rw-r--r-- | guix/scripts/browse.scm | 111 |
1 files changed, 111 insertions, 0 deletions
diff --git a/guix/scripts/browse.scm b/guix/scripts/browse.scm new file mode 100644 index 0000000..86c6d42 --- /dev/null +++ b/guix/scripts/browse.scm @@ -0,0 +1,111 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © Oleg Pykhalov <go.wigust@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 (guix scripts browse) + #:use-module (guix ui) + #:use-module (guix scripts) + #:use-module (guix utils) + #:use-module (guix packages) + #:use-module (gnu packages) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-37) + #:export (%browser + guix-browse)) + +(define %options + (list (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix edit"))))) + +(define (show-help) + (display (G_ "Usage: guix edit PACKAGE... +Start $VISUAL or $EDITOR to edit the definitions of PACKAGE...\n")) + (newline) + (display (G_ " + -h, --help display this help and exit")) + (display (G_ " + -V, --version display version information and exit")) + (newline) + (show-bug-report-information)) + +(define %browser + ;; XXX: It would be better to default to something more likely to be + ;; pre-installed on an average GNU system. Since Nano is not suited for + ;; editing Scheme, Emacs is used instead. + (make-parameter (or (getenv "BROWSER") "icecat"))) + +(define %ci-url + "https://hydra.gnu.org/job/gnu/master/") + +(define (search-path* path file) + "Like 'search-path' but exit if FILE is not found." + (let ((absolute-file-name (search-path path file))) + (unless absolute-file-name + ;; Shouldn't happen unless somebody fiddled with the 'location' field. + (leave (G_ "file '~a' not found in search path ~s~%") + file path)) + absolute-file-name)) + +(define (package->location-specification package) + "Return the location specification for PACKAGE for a typical editor command +line." + (let ((loc (package-location package))) + (list (string-append "+" + (number->string + (location-line loc))) + (search-path* %load-path (location-file loc))))) + + +(define (guix-browse . args) + (define (parse-arguments) + ;; Return the alist of option values. + (args-fold* args %options + (lambda (opt name arg result) + (leave (G_ "~A: unrecognized option~%") name)) + cons + '())) + + (with-error-handling + (let* ((specs (reverse (parse-arguments))) + (packages (map specification->package specs))) + (for-each (lambda (package) + (unless (package-location package) + (leave (G_ "source location of package '~a' is unknown~%") + (package-full-name package)))) + packages) + + (catch 'system-error + (lambda () + (let ((file-names (append-map (lambda (package) + (string-append (package-name package) + "-" (package-version package) + "." (%current-system))) + packages))) + ;; Use `system' instead of `exec' in order to sanely handle + ;; possible command line arguments in %BROWSER. + (exit (system (string-join (list (%browser) + (string-append %ci-url + file-names))))))) + (lambda args + (let ((errno (system-error-errno args))) + (leave (G_ "failed to launch '~a': ~a~%") + (%browser) (strerror errno)))))))) |