~ruther/guix-local

ref: 4d32b17c19cc86a5bd63d0a7bc2735c5da3a5f4a guix-local/guix/scripts/import/elpa.scm -rw-r--r-- 5.1 KiB
4d32b17c — jgart gnu: sbcl-cl-change-case: Update to 1.0. a month ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;; Copyright © 2023 Simon Tournier <zimon.toutoune@gmail.com>
;;; Copyright © 2025 jgart <jgart@dismail.de>
;;; Copyright © 2025 Liliana Marie Prikler <liliana.prikler@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 import elpa)
  #:use-module (guix ui)
  #:use-module (guix utils)
  #:use-module (guix scripts)
  #:use-module (guix import elpa)
  #:use-module (guix import utils)
  #:use-module (guix scripts import)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-11)
  #:use-module (srfi srfi-37)
  #:use-module (ice-9 match)
  #:use-module (ice-9 format)
  #:export (guix-import-elpa))


;;;
;;; Command-line options.
;;;

(define %default-options
  '((repo . gnu)))

(define (show-help)
  (display (G_ "Usage: guix import elpa PACKAGE-NAME
Import the latest package named PACKAGE-NAME from an ELPA repository.\n"))
  (display (G_ "
  -a, --archive=ARCHIVE          specify the archive repository"))
  (display (G_ "
  -l, --list-archives            list ELPA repositories supported by the importer"))
  (display (G_ "
  -h, --help                     display this help and exit"))
  (display (G_ "
  -r, --recursive                generate package expressions for all Emacs packages that are not yet in Guix"))
  (display (G_ "
  -V, --version                  display version information and exit"))
  (newline)
  (show-bug-report-information))

(define %options
  ;; Specification of the command-line options.
  (cons* (option '(#\h "help") #f #f
                 (lambda args
                   (show-help)
                   (exit 0)))
         (option '(#\V "version") #f #f
                 (lambda args
                   (show-version-and-exit "guix import elpa")))
         (option '(#\a "archive") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'repo (string->symbol arg)
                               (alist-delete 'repo result))))
         (option '(#\l "list-archives") #f #f
                 (lambda (opt name arg result)
                   (display (G_ "The following archives are supported:\n"))
                   (for-each (match-lambda
                               ((sym . repo)
                                (format #t "  ~a: ~a\n" sym repo)))
                             %elpa-archives)
                   (display
                    (G_ "The argument to --archive should be one of these \
symbols, e.g. gnu (the default).\n"))
                   (exit 0)))
         (option '(#\r "recursive") #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'recursive #t result)))
         %standard-import-options))


;;;
;;; Entry point.
;;;

(define (guix-import-elpa . args)
  (define (parse-options)
    ;; Return the alist of option values.
    (parse-command-line args %options (list %default-options)
                        #:build-options? #f))

  (let* ((opts (parse-options))
         (args (filter-map (match-lambda
                            (('argument . value)
                             value)
                            (_ #f))
                           (reverse opts))))
    (match args
      ((spec)
       (define-values (package-name version)
         (package-name->name+version spec))
       (when version
         (warning (G_ "this importer does not consider the version~%")))
       (match (if (assoc-ref opts 'recursive)
                  (elpa-recursive-import package-name
                                         (or (assoc-ref opts 'repo) 'gnu))
                  (elpa->guix-package package-name
                                      #:repo (assoc-ref opts 'repo)))
         ((or #f '())
          (leave (G_ "failed to download meta-data for package '~a'~%") package-name))
         (('package etc ...) `(package ,@etc))
         ((? list? sexps) (map
                           (match-lambda
                             ((and ('package ('name name) . rest) pkg)
                              `(define-public ,(string->symbol name)
                                 ,pkg))
                             (_ #f))
                           sexps))))
      (()
       (leave (G_ "too few arguments~%")))
      ((many ...)
       (leave (G_ "too many arguments~%"))))))

;;; elpa.scm ends here