edit: Add '--load-path' option.
[jackhill/guix/guix.git] / guix / scripts / edit.scm
CommitLineData
39bee8a2 1;;; GNU Guix --- Functional package management for GNU
ee8099f5 2;;; Copyright © 2015, 2016, 2019 Ludovic Courtès <ludo@gnu.org>
b16dbd13 3;;; Copyright © 2015 Mathieu Lirzin <mthl@gnu.org>
3c8396b5 4;;; Copyright © 2020 Simon Tournier <zimon.toutoune@gmail.com>
39bee8a2
LC
5;;;
6;;; This file is part of GNU Guix.
7;;;
8;;; GNU Guix is free software; you can redistribute it and/or modify it
9;;; under the terms of the GNU General Public License as published by
10;;; the Free Software Foundation; either version 3 of the License, or (at
11;;; your option) any later version.
12;;;
13;;; GNU Guix is distributed in the hope that it will be useful, but
14;;; WITHOUT ANY WARRANTY; without even the implied warranty of
15;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16;;; GNU General Public License for more details.
17;;;
18;;; You should have received a copy of the GNU General Public License
19;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
20
21(define-module (guix scripts edit)
22 #:use-module (guix ui)
88981dd3 23 #:use-module (guix scripts)
3c8396b5 24 #:use-module ((guix scripts build) #:select (%standard-build-options))
39bee8a2 25 #:use-module (guix utils)
39bee8a2
LC
26 #:use-module (gnu packages)
27 #:use-module (srfi srfi-1)
28 #:use-module (srfi srfi-37)
29 #:export (%editor
30 guix-edit))
31
32(define %options
3c8396b5 33 (list (find (lambda (option)
34 (member "load-path" (option-names option)))
35 %standard-build-options)
36 (option '(#\h "help") #f #f
39bee8a2
LC
37 (lambda args
38 (show-help)
39 (exit 0)))
40 (option '(#\V "version") #f #f
41 (lambda args
42 (show-version-and-exit "guix edit")))))
43
44(define (show-help)
69daee23 45 (display (G_ "Usage: guix edit PACKAGE...
6237b9fa 46Start $VISUAL or $EDITOR to edit the definitions of PACKAGE...\n"))
3c8396b5 47 (newline)
48 (display (G_ "
49 -L, --load-path=DIR prepend DIR to the package module search path"))
39bee8a2 50 (newline)
69daee23 51 (display (G_ "
39bee8a2 52 -h, --help display this help and exit"))
69daee23 53 (display (G_ "
39bee8a2
LC
54 -V, --version display version information and exit"))
55 (newline)
56 (show-bug-report-information))
57
58(define %editor
cd08fe42
ML
59 ;; XXX: It would be better to default to something more likely to be
60 ;; pre-installed on an average GNU system. Since Nano is not suited for
61 ;; editing Scheme, Emacs is used instead.
62 (make-parameter (or (getenv "VISUAL") (getenv "EDITOR") "emacs")))
39bee8a2
LC
63
64(define (search-path* path file)
65 "Like 'search-path' but exit if FILE is not found."
66 (let ((absolute-file-name (search-path path file)))
67 (unless absolute-file-name
68 ;; Shouldn't happen unless somebody fiddled with the 'location' field.
69daee23 69 (leave (G_ "file '~a' not found in search path ~s~%")
39bee8a2
LC
70 file path))
71 absolute-file-name))
72
ee8099f5
LC
73(define (location->location-specification location)
74 "Return the location specification for LOCATION for a typical editor command
67c920fa 75line."
ee8099f5
LC
76 (list (string-append "+"
77 (number->string
78 (location-line location)))
79 (search-path* %load-path (location-file location))))
67c920fa 80
39bee8a2
LC
81\f
82(define (guix-edit . args)
00677a7e
LC
83 (define (parse-arguments)
84 ;; Return the list of package names.
85 (args-fold* args %options
86 (lambda (opt name arg result)
69daee23 87 (leave (G_ "~A: unrecognized option~%") name))
00677a7e
LC
88 cons
89 '()))
90
39bee8a2 91 (with-error-handling
ee8099f5
LC
92 (let* ((specs (reverse (parse-arguments)))
93 (locations (map specification->location specs)))
650f1615
LC
94
95 (catch 'system-error
96 (lambda ()
ee8099f5
LC
97 (let ((file-names (append-map location->location-specification
98 locations)))
b16dbd13
ML
99 ;; Use `system' instead of `exec' in order to sanely handle
100 ;; possible command line arguments in %EDITOR.
101 (exit (system (string-join (cons (%editor) file-names))))))
650f1615
LC
102 (lambda args
103 (let ((errno (system-error-errno args)))
69daee23 104 (leave (G_ "failed to launch '~a': ~a~%")
650f1615 105 (%editor) (strerror errno))))))))