mirrored from git://git.sv.gnu.org/emacs.git
/
package.el
3536 lines (3203 loc) · 149 KB
/
package.el
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
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
;;; package.el --- Simple package system for Emacs -*- lexical-binding:t -*-
;; Copyright (C) 2007-2018 Free Software Foundation, Inc.
;; Author: Tom Tromey <tromey@redhat.com>
;; Daniel Hackney <dan@haxney.org>
;; Created: 10 Mar 2007
;; Version: 1.1.0
;; Keywords: tools
;; Package-Requires: ((tabulated-list "1.0"))
;; This file is part of GNU Emacs.
;; GNU Emacs 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 Emacs 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 Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; The idea behind package.el is to be able to download packages and
;; install them. Packages are versioned and have versioned
;; dependencies. Furthermore, this supports built-in packages which
;; may or may not be newer than user-specified packages. This makes
;; it possible to upgrade Emacs and automatically disable packages
;; which have moved from external to core. (Note though that we don't
;; currently register any of these, so this feature does not actually
;; work.)
;; A package is described by its name and version. The distribution
;; format is either a tar file or a single .el file.
;; A tar file should be named "NAME-VERSION.tar". The tar file must
;; unpack into a directory named after the package and version:
;; "NAME-VERSION". It must contain a file named "PACKAGE-pkg.el"
;; which consists of a call to define-package. It may also contain a
;; "dir" file and the info files it references.
;; A .el file is named "NAME-VERSION.el" in the remote archive, but is
;; installed as simply "NAME.el" in a directory named "NAME-VERSION".
;; The downloader downloads all dependent packages. By default,
;; packages come from the official GNU sources, but others may be
;; added by customizing the `package-archives' alist. Packages get
;; byte-compiled at install time.
;; At activation time we will set up the load-path and the info path,
;; and we will load the package's autoloads. If a package's
;; dependencies are not available, we will not activate that package.
;; Conceptually a package has multiple state transitions:
;;
;; * Download. Fetching the package from ELPA.
;; * Install. Untar the package, or write the .el file, into
;; ~/.emacs.d/elpa/ directory.
;; * Autoload generation.
;; * Byte compile. Currently this phase is done during install,
;; but we may change this.
;; * Activate. Evaluate the autoloads for the package to make it
;; available to the user.
;; * Load. Actually load the package and run some code from it.
;; Other external functions you may want to use:
;;
;; M-x list-packages
;; Enters a mode similar to buffer-menu which lets you manage
;; packages. You can choose packages for install (mark with "i",
;; then "x" to execute) or deletion (not implemented yet), and you
;; can see what packages are available. This will automatically
;; fetch the latest list of packages from ELPA.
;;
;; M-x package-install-from-buffer
;; Install a package consisting of a single .el file that appears
;; in the current buffer. This only works for packages which
;; define a Version header properly; package.el also supports the
;; extension headers Package-Version (in case Version is an RCS id
;; or similar), and Package-Requires (if the package requires other
;; packages).
;;
;; M-x package-install-file
;; Install a package from the indicated file. The package can be
;; either a tar file or a .el file. A tar file must contain an
;; appropriately-named "-pkg.el" file; a .el file must be properly
;; formatted as with package-install-from-buffer.
;;; Thanks:
;;; (sorted by sort-lines):
;; Jim Blandy <jimb@red-bean.com>
;; Karl Fogel <kfogel@red-bean.com>
;; Kevin Ryde <user42@zip.com.au>
;; Lawrence Mitchell
;; Michael Olson <mwolson@member.fsf.org>
;; Sebastian Tennant <sebyte@smolny.plus.com>
;; Stefan Monnier <monnier@iro.umontreal.ca>
;; Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Phil Hagelberg <phil@hagelb.org>
;;; ToDo:
;; - putting info dirs at the start of the info path means
;; users see a weird ordering of categories. OTOH we want to
;; override later entries. maybe emacs needs to enforce
;; the standard layout?
;; - put bytecode in a separate directory tree
;; - perhaps give users a way to recompile their bytecode
;; or do it automatically when emacs changes
;; - give users a way to know whether a package is installed ok
;; - give users a way to view a package's documentation when it
;; only appears in the .el
;; - use/extend checkdoc so people can tell if their package will work
;; - "installed" instead of a blank in the status column
;; - tramp needs its files to be compiled in a certain order.
;; how to handle this? fix tramp?
;; - maybe we need separate .elc directories for various emacs versions
;; and also emacs-vs-xemacs. That way conditional compilation can
;; work. But would this break anything?
;; - William Xu suggests being able to open a package file without
;; installing it
;; - Interface with desktop.el so that restarting after an install
;; works properly
;; - Use hierarchical layout. PKG/etc PKG/lisp PKG/info
;; ... except maybe lisp?
;; - It may be nice to have a macro that expands to the package's
;; private data dir, aka ".../etc". Or, maybe data-directory
;; needs to be a list (though this would be less nice)
;; a few packages want this, eg sokoban
;; - Allow multiple versions on the server, so that if a user doesn't
;; meet the requirements for the most recent version they can still
;; install an older one.
;; - Allow optional package dependencies
;; then if we require 'bbdb', bbdb-specific lisp in lisp/bbdb
;; and just don't compile to add to load path ...?
;; - Our treatment of the info path is somewhat bogus
;;; Code:
(require 'cl-lib)
(eval-when-compile (require 'subr-x))
(eval-when-compile (require 'epg)) ;For setf accessors.
(require 'seq)
(require 'tabulated-list)
(require 'macroexp)
(require 'url-handlers)
(defgroup package nil
"Manager for Emacs Lisp packages."
:group 'applications
:version "24.1")
;;; Customization options
;;;###autoload
(defcustom package-enable-at-startup t
"Whether to make installed packages available when Emacs starts.
If non-nil, packages are made available before reading the init
file (but after reading the early init file). This means that if
you wish to set this variable, you must do so in the early init
file. Regardless of the value of this variable, packages are not
made available if `user-init-file' is nil (e.g. Emacs was started
with \"-q\").
Even if the value is nil, you can type \\[package-initialize] to
make installed packages available at any time, or you can
call (package-initialize) in your init-file."
:type 'boolean
:version "24.1")
(defcustom package-load-list '(all)
"List of packages for `package-initialize' to make available.
Each element in this list should be a list (NAME VERSION), or the
symbol `all'. The symbol `all' says to make available the latest
installed versions of all packages not specified by other
elements.
For an element (NAME VERSION), NAME is a package name (a symbol).
VERSION should be t, a string, or nil.
If VERSION is t, the most recent version is made available.
If VERSION is a string, only that version is ever made available.
Any other version, even if newer, is silently ignored.
Hence, the package is \"held\" at that version.
If VERSION is nil, the package is not made available (it is \"disabled\")."
:type '(repeat (choice (const all)
(list :tag "Specific package"
(symbol :tag "Package name")
(choice :tag "Version"
(const :tag "disable" nil)
(const :tag "most recent" t)
(string :tag "specific version")))))
:risky t
:version "24.1")
(defcustom package-archives `(("gnu" .
,(format "http%s://elpa.gnu.org/packages/"
(if (gnutls-available-p) "s" ""))))
"An alist of archives from which to fetch.
The default value points to the GNU Emacs package repository.
Each element has the form (ID . LOCATION).
ID is an archive name, as a string.
LOCATION specifies the base location for the archive.
If it starts with \"http(s):\", it is treated as an HTTP(S) URL;
otherwise it should be an absolute directory name.
(Other types of URL are currently not supported.)
Only add locations that you trust, since fetching and installing
a package can run arbitrary code."
:type '(alist :key-type (string :tag "Archive name")
:value-type (string :tag "URL or directory name"))
:risky t
:version "26.1") ; gnutls test
(defcustom package-menu-hide-low-priority 'archive
"If non-nil, hide low priority packages from the packages menu.
A package is considered low priority if there's another version
of it available such that:
(a) the archive of the other package is higher priority than
this one, as per `package-archive-priorities';
or
(b) they both have the same archive priority but the other
package has a higher version number.
This variable has three possible values:
nil: no packages are hidden;
`archive': only criterion (a) is used;
t: both criteria are used.
This variable has no effect if `package-menu--hide-packages' is
nil, so it can be toggled with \\<package-menu-mode-map> \\[package-menu-toggle-hiding]."
:type '(choice (const :tag "Don't hide anything" nil)
(const :tag "Hide per package-archive-priorities"
archive)
(const :tag "Hide per archive and version number" t))
:version "25.1")
(defcustom package-archive-priorities nil
"An alist of priorities for packages.
Each element has the form (ARCHIVE-ID . PRIORITY).
When installing packages, the package with the highest version
number from the archive with the highest priority is
selected. When higher versions are available from archives with
lower priorities, the user has to select those manually.
Archives not in this list have the priority 0.
See also `package-menu-hide-low-priority'."
:type '(alist :key-type (string :tag "Archive name")
:value-type (integer :tag "Priority (default is 0)"))
:risky t
:version "25.1")
(defcustom package-pinned-packages nil
"An alist of packages that are pinned to specific archives.
This can be useful if you have multiple package archives enabled,
and want to control which archive a given package gets installed from.
Each element of the alist has the form (PACKAGE . ARCHIVE), where:
PACKAGE is a symbol representing a package
ARCHIVE is a string representing an archive (it should be the car of
an element in `package-archives', e.g. \"gnu\").
Adding an entry to this variable means that only ARCHIVE will be
considered as a source for PACKAGE. If other archives provide PACKAGE,
they are ignored (for this package). If ARCHIVE does not contain PACKAGE,
the package will be unavailable."
:type '(alist :key-type (symbol :tag "Package")
:value-type (string :tag "Archive name"))
;; I don't really see why this is risky...
;; I suppose it could prevent you receiving updates for a package,
;; via an entry (PACKAGE . NON-EXISTING). Which could be an issue
;; if PACKAGE has a known vulnerability that is fixed in newer versions.
:risky t
:version "24.4")
(defcustom package-user-dir (locate-user-emacs-file "elpa")
"Directory containing the user's Emacs Lisp packages.
The directory name should be absolute.
Apart from this directory, Emacs also looks for system-wide
packages in `package-directory-list'."
:type 'directory
:risky t
:version "24.1")
(defcustom package-directory-list
;; Defaults are subdirs named "elpa" in the site-lisp dirs.
(let (result)
(dolist (f load-path)
(and (stringp f)
(equal (file-name-nondirectory f) "site-lisp")
(push (expand-file-name "elpa" f) result)))
(nreverse result))
"List of additional directories containing Emacs Lisp packages.
Each directory name should be absolute.
These directories contain packages intended for system-wide; in
contrast, `package-user-dir' contains packages for personal use."
:type '(repeat directory)
:risky t
:version "24.1")
(declare-function epg-find-configuration "epg-config"
(protocol &optional no-cache program-alist))
(defcustom package-gnupghome-dir (expand-file-name "gnupg" package-user-dir)
"Directory containing GnuPG keyring or nil.
This variable specifies the GnuPG home directory used by package.
That directory is passed via the option \"--homedir\" to GnuPG.
If nil, do not use the option \"--homedir\", but stick with GnuPG's
default directory."
:type `(choice
(const
:tag "Default Emacs package management GnuPG home directory"
,(expand-file-name "gnupg" package-user-dir))
(const
:tag "Default GnuPG directory (GnuPG option --homedir not used)"
nil)
(directory :tag "A specific GnuPG --homedir"))
:risky t
:version "26.1")
(defcustom package-check-signature
(if (and (require 'epg-config)
(epg-find-configuration 'OpenPGP))
'allow-unsigned)
"Non-nil means to check package signatures when installing.
The value `allow-unsigned' means to still install a package even if
it is unsigned.
This also applies to the \"archive-contents\" file that lists the
contents of the archive."
:type '(choice (const nil :tag "Never")
(const allow-unsigned :tag "Allow unsigned")
(const t :tag "Check always"))
:risky t
:version "24.4")
(defcustom package-unsigned-archives nil
"List of archives where we do not check for package signatures."
:type '(repeat (string :tag "Archive name"))
:risky t
:version "24.4")
(defcustom package-selected-packages nil
"Store here packages installed explicitly by user.
This variable is fed automatically by Emacs when installing a new package.
This variable is used by `package-autoremove' to decide
which packages are no longer needed.
You can use it to (re)install packages on other machines
by running `package-install-selected-packages'.
To check if a package is contained in this list here, use
`package--user-selected-p', as it may populate the variable with
a sane initial value."
:version "25.1"
:type '(repeat symbol))
(defcustom package-menu-async t
"If non-nil, package-menu will use async operations when possible.
Currently, only the refreshing of archive contents supports
asynchronous operations. Package transactions are still done
synchronously."
:type 'boolean
:version "25.1")
;;; `package-desc' object definition
;; This is the struct used internally to represent packages.
;; Functions that deal with packages should generally take this object
;; as an argument. In some situations (e.g. commands that query the
;; user) it makes sense to take the package name as a symbol instead,
;; but keep in mind there could be multiple `package-desc's with the
;; same name.
(defvar package--default-summary "No description available.")
(cl-defstruct (package-desc
;; Rename the default constructor from `make-package-desc'.
(:constructor package-desc-create)
;; Has the same interface as the old `define-package',
;; which is still used in the "foo-pkg.el" files. Extra
;; options can be supported by adding additional keys.
(:constructor
package-desc-from-define
(name-string version-string &optional summary requirements
&rest rest-plist
&aux
(name (intern name-string))
(version (version-to-list version-string))
(reqs (mapcar #'(lambda (elt)
(list (car elt)
(version-to-list (cadr elt))))
(if (eq 'quote (car requirements))
(nth 1 requirements)
requirements)))
(kind (plist-get rest-plist :kind))
(archive (plist-get rest-plist :archive))
(extras (let (alist)
(while rest-plist
(unless (memq (car rest-plist) '(:kind :archive))
(let ((value (cadr rest-plist)))
(when value
(push (cons (car rest-plist)
(if (eq (car-safe value) 'quote)
(cadr value)
value))
alist))))
(setq rest-plist (cddr rest-plist)))
alist)))))
"Structure containing information about an individual package.
Slots:
`name' Name of the package, as a symbol.
`version' Version of the package, as a version list.
`summary' Short description of the package, typically taken from
the first line of the file.
`reqs' Requirements of the package. A list of (PACKAGE
VERSION-LIST) naming the dependent package and the minimum
required version.
`kind' The distribution format of the package. Currently, it is
either `single' or `tar'.
`archive' The name of the archive (as a string) whence this
package came.
`dir' The directory where the package is installed (if installed),
`builtin' if it is built-in, or nil otherwise.
`extras' Optional alist of additional keyword-value pairs.
`signed' Flag to indicate that the package is signed by provider."
name
version
(summary package--default-summary)
reqs
kind
archive
dir
extras
signed)
(defun package--from-builtin (bi-desc)
(package-desc-create :name (pop bi-desc)
:version (package--bi-desc-version bi-desc)
:summary (package--bi-desc-summary bi-desc)
:dir 'builtin))
;; Pseudo fields.
(defun package-version-join (vlist)
"Return the version string corresponding to the list VLIST.
This is, approximately, the inverse of `version-to-list'.
\(Actually, it returns only one of the possible inverses, since
`version-to-list' is a many-to-one operation.)"
(if (null vlist)
""
(let ((str-list (list "." (int-to-string (car vlist)))))
(dolist (num (cdr vlist))
(cond
((>= num 0)
(push (int-to-string num) str-list)
(push "." str-list))
((< num -4)
(error "Invalid version list `%s'" vlist))
(t
;; pre, or beta, or alpha
(cond ((equal "." (car str-list))
(pop str-list))
((not (string-match "[0-9]+" (car str-list)))
(error "Invalid version list `%s'" vlist)))
(push (cond ((= num -1) "pre")
((= num -2) "beta")
((= num -3) "alpha")
((= num -4) "snapshot"))
str-list))))
(if (equal "." (car str-list))
(pop str-list))
(apply 'concat (nreverse str-list)))))
(defun package-desc-full-name (pkg-desc)
(format "%s-%s"
(package-desc-name pkg-desc)
(package-version-join (package-desc-version pkg-desc))))
(defun package-desc-suffix (pkg-desc)
(pcase (package-desc-kind pkg-desc)
(`single ".el")
(`tar ".tar")
(`dir "")
(kind (error "Unknown package kind: %s" kind))))
(defun package-desc--keywords (pkg-desc)
(let ((keywords (cdr (assoc :keywords (package-desc-extras pkg-desc)))))
(if (eq (car-safe keywords) 'quote)
(nth 1 keywords)
keywords)))
(defun package-desc-priority (p)
"Return the priority of the archive of package-desc object P."
(package-archive-priority (package-desc-archive p)))
;; Package descriptor format used in finder-inf.el and package--builtins.
(cl-defstruct (package--bi-desc
(:constructor package-make-builtin (version summary))
(:type vector))
version
reqs
summary)
;;; Installed packages
;; The following variables store information about packages present in
;; the system. The most important of these is `package-alist'. The
;; command `package-initialize' is also closely related to this
;; section, but it is left for a later section because it also affects
;; other stuff.
(defvar package--builtins nil
"Alist of built-in packages.
The actual value is initialized by loading the library
`finder-inf'; this is not done until it is needed, e.g. by the
function `package-built-in-p'.
Each element has the form (PKG . PACKAGE-BI-DESC), where PKG is a package
name (a symbol) and DESC is a `package--bi-desc' structure.")
(put 'package--builtins 'risky-local-variable t)
(defvar package-alist nil
"Alist of all packages available for activation.
Each element has the form (PKG . DESCS), where PKG is a package
name (a symbol) and DESCS is a non-empty list of `package-desc' structure,
sorted by decreasing versions.
This variable is set automatically by `package-load-descriptor',
called via `package-initialize'. To change which packages are
loaded and/or activated, customize `package-load-list'.")
(put 'package-alist 'risky-local-variable t)
(defvar package-activated-list nil
;; FIXME: This should implicitly include all builtin packages.
"List of the names of currently activated packages.")
(put 'package-activated-list 'risky-local-variable t)
;;;; Populating `package-alist'.
;; The following functions are called on each installed package by
;; `package-load-all-descriptors', which ultimately populates the
;; `package-alist' variable.
(defun package-process-define-package (exp)
(when (eq (car-safe exp) 'define-package)
(let* ((new-pkg-desc (apply #'package-desc-from-define (cdr exp)))
(name (package-desc-name new-pkg-desc))
(version (package-desc-version new-pkg-desc))
(old-pkgs (assq name package-alist)))
(if (null old-pkgs)
;; If there's no old package, just add this to `package-alist'.
(push (list name new-pkg-desc) package-alist)
;; If there is, insert the new package at the right place in the list.
(while
(if (and (cdr old-pkgs)
(version-list-< version
(package-desc-version (cadr old-pkgs))))
(setq old-pkgs (cdr old-pkgs))
(push new-pkg-desc (cdr old-pkgs))
nil)))
new-pkg-desc)))
(defun package-load-descriptor (pkg-dir)
"Load the description file in directory PKG-DIR."
(let ((pkg-file (expand-file-name (package--description-file pkg-dir)
pkg-dir))
(signed-file (concat pkg-dir ".signed")))
(when (file-exists-p pkg-file)
(with-temp-buffer
(insert-file-contents pkg-file)
(goto-char (point-min))
(let ((pkg-desc (or (package-process-define-package
(read (current-buffer)))
(error "Can't find define-package in %s" pkg-file))))
(setf (package-desc-dir pkg-desc) pkg-dir)
(if (file-exists-p signed-file)
(setf (package-desc-signed pkg-desc) t))
pkg-desc)))))
(defun package-load-all-descriptors ()
"Load descriptors for installed Emacs Lisp packages.
This looks for package subdirectories in `package-user-dir' and
`package-directory-list'. The variable `package-load-list'
controls which package subdirectories may be loaded.
In each valid package subdirectory, this function loads the
description file containing a call to `define-package', which
updates `package-alist'."
(dolist (dir (cons package-user-dir package-directory-list))
(when (file-directory-p dir)
(dolist (subdir (directory-files dir))
(unless (equal subdir "..")
(let ((pkg-dir (expand-file-name subdir dir)))
(when (file-directory-p pkg-dir)
(package-load-descriptor pkg-dir))))))))
(defun define-package (_name-string _version-string
&optional _docstring _requirements
&rest _extra-properties)
"Define a new package.
NAME-STRING is the name of the package, as a string.
VERSION-STRING is the version of the package, as a string.
DOCSTRING is a short description of the package, a string.
REQUIREMENTS is a list of dependencies on other packages.
Each requirement is of the form (OTHER-PACKAGE OTHER-VERSION),
where OTHER-VERSION is a string.
EXTRA-PROPERTIES is currently unused."
;; FIXME: Placeholder! Should we keep it?
(error "Don't call me!"))
;;; Package activation
;; Section for functions used by `package-activate', which see.
(defun package-disabled-p (pkg-name version)
"Return whether PKG-NAME at VERSION can be activated.
The decision is made according to `package-load-list'.
Return nil if the package can be activated.
Return t if the package is completely disabled.
Return the max version (as a string) if the package is held at a lower version."
(let ((force (assq pkg-name package-load-list)))
(cond ((null force) (not (memq 'all package-load-list)))
((null (setq force (cadr force))) t) ; disabled
((eq force t) nil)
((stringp force) ; held
(unless (version-list-= version (version-to-list force))
force))
(t (error "Invalid element in `package-load-list'")))))
(defun package-built-in-p (package &optional min-version)
"Return non-nil if PACKAGE is built-in to Emacs.
Optional arg MIN-VERSION, if non-nil, should be a version list
specifying the minimum acceptable version."
(if (package-desc-p package) ;; was built-in and then was converted
(eq 'builtin (package-desc-dir package))
(let ((bi (assq package package--builtin-versions)))
(cond
(bi (version-list-<= min-version (cdr bi)))
((remove 0 min-version) nil)
(t
(require 'finder-inf nil t) ; For `package--builtins'.
(assq package package--builtins))))))
(defun package--autoloads-file-name (pkg-desc)
"Return the absolute name of the autoloads file, sans extension.
PKG-DESC is a `package-desc' object."
(expand-file-name
(format "%s-autoloads" (package-desc-name pkg-desc))
(package-desc-dir pkg-desc)))
(defun package--activate-autoloads-and-load-path (pkg-desc)
"Load the autoloads file and add package dir to `load-path'.
PKG-DESC is a `package-desc' object."
(let* ((old-lp load-path)
(pkg-dir (package-desc-dir pkg-desc))
(pkg-dir-dir (file-name-as-directory pkg-dir)))
(with-demoted-errors "Error loading autoloads: %s"
(load (package--autoloads-file-name pkg-desc) nil t))
(when (and (eq old-lp load-path)
(not (or (member pkg-dir load-path)
(member pkg-dir-dir load-path))))
;; Old packages don't add themselves to the `load-path', so we have to
;; do it ourselves.
(push pkg-dir load-path))))
(defvar Info-directory-list)
(declare-function info-initialize "info" ())
(defvar package--quickstart-pkgs t
"If set to a list, we're computing the set of pkgs to activate.")
(defun package--load-files-for-activation (pkg-desc reload)
"Load files for activating a package given by PKG-DESC.
Load the autoloads file, and ensure `load-path' is setup. If
RELOAD is non-nil, also load all files in the package that
correspond to previously loaded files."
(let* ((loaded-files-list (when reload
(package--list-loaded-files (package-desc-dir pkg-desc)))))
;; Add to load path, add autoloads, and activate the package.
(package--activate-autoloads-and-load-path pkg-desc)
;; Call `load' on all files in `package-desc-dir' already present in
;; `load-history'. This is done so that macros in these files are updated
;; to their new definitions. If another package is being installed which
;; depends on this new definition, not doing this update would cause
;; compilation errors and break the installation.
(with-demoted-errors "Error in package--load-files-for-activation: %s"
(mapc (lambda (feature) (load feature nil t))
;; Skip autoloads file since we already evaluated it above.
(remove (file-truename (package--autoloads-file-name pkg-desc))
loaded-files-list)))))
(defun package-activate-1 (pkg-desc &optional reload deps)
"Activate package given by PKG-DESC, even if it was already active.
If DEPS is non-nil, also activate its dependencies (unless they
are already activated).
If RELOAD is non-nil, also `load' any files inside the package which
correspond to previously loaded files (those returned by
`package--list-loaded-files')."
(let* ((name (package-desc-name pkg-desc))
(pkg-dir (package-desc-dir pkg-desc)))
(unless pkg-dir
(error "Internal error: unable to find directory for `%s'"
(package-desc-full-name pkg-desc)))
(catch 'exit
;; Activate its dependencies recursively.
;; FIXME: This doesn't check whether the activated version is the
;; required version.
(when deps
(dolist (req (package-desc-reqs pkg-desc))
(unless (package-activate (car req))
(message "Unable to activate package `%s'.\nRequired package `%s-%s' is unavailable"
name (car req) (package-version-join (cadr req)))
(throw 'exit nil))))
(if (listp package--quickstart-pkgs)
;; We're only collecting the set of packages to activate!
(push pkg-desc package--quickstart-pkgs)
(package--load-files-for-activation pkg-desc reload))
;; Add info node.
(when (file-exists-p (expand-file-name "dir" pkg-dir))
;; FIXME: not the friendliest, but simple.
(require 'info)
(info-initialize)
(push pkg-dir Info-directory-list))
(push name package-activated-list)
;; Don't return nil.
t)))
(declare-function find-library-name "find-func" (library))
(defun package--list-loaded-files (dir)
"Recursively list all files in DIR which correspond to loaded features.
Returns the `file-name-sans-extension' of each file, relative to
DIR, sorted by most recently loaded last."
(let* ((history (delq nil
(mapcar (lambda (x)
(let ((f (car x)))
(and f (file-name-sans-extension f))))
load-history)))
(dir (file-truename dir))
;; List all files that have already been loaded.
(list-of-conflicts
(delq
nil
(mapcar
(lambda (x) (let* ((file (file-relative-name x dir))
;; Previously loaded file, if any.
(previous
(ignore-errors
(file-name-sans-extension
(file-truename (find-library-name file)))))
(pos (when previous (member previous history))))
;; Return (RELATIVE-FILENAME . HISTORY-POSITION)
(when pos
(cons (file-name-sans-extension file) (length pos)))))
(directory-files-recursively dir "\\`[^\\.].*\\.el\\'")))))
;; Turn the list of (FILENAME . POS) back into a list of features. Files in
;; subdirectories are returned relative to DIR (so not actually features).
(let ((default-directory (file-name-as-directory dir)))
(mapcar (lambda (x) (file-truename (car x)))
(sort list-of-conflicts
;; Sort the files by ascending HISTORY-POSITION.
(lambda (x y) (< (cdr x) (cdr y))))))))
;;;; `package-activate'
;; This function activates a newer version of a package if an older
;; one was already activated. It also loads a features of this
;; package which were already loaded.
(defun package-activate (package &optional force)
"Activate the package named PACKAGE.
If FORCE is true, (re-)activate it if it's already activated.
Newer versions are always activated, regardless of FORCE."
(let ((pkg-descs (cdr (assq package package-alist))))
;; Check if PACKAGE is available in `package-alist'.
(while
(when pkg-descs
(let ((available-version (package-desc-version (car pkg-descs))))
(or (package-disabled-p package available-version)
;; Prefer a builtin package.
(package-built-in-p package available-version))))
(setq pkg-descs (cdr pkg-descs)))
(cond
;; If no such package is found, maybe it's built-in.
((null pkg-descs)
(package-built-in-p package))
;; If the package is already activated, just return t.
((and (memq package package-activated-list) (not force))
t)
;; Otherwise, proceed with activation.
(t (package-activate-1 (car pkg-descs) nil 'deps)))))
;;; Installation -- Local operations
;; This section contains a variety of features regarding installing a
;; package to/from disk. This includes autoload generation,
;; unpacking, compiling, as well as defining a package from the
;; current buffer.
;;;; Unpacking
(defvar tar-parse-info)
(declare-function tar-untar-buffer "tar-mode" ())
(declare-function tar-header-name "tar-mode" (tar-header) t)
(declare-function tar-header-link-type "tar-mode" (tar-header) t)
(defun package-untar-buffer (dir)
"Untar the current buffer.
This uses `tar-untar-buffer' from Tar mode. All files should
untar into a directory named DIR; otherwise, signal an error."
(require 'tar-mode)
(tar-mode)
;; Make sure everything extracts into DIR.
(let ((regexp (concat "\\`" (regexp-quote (expand-file-name dir)) "/"))
(case-fold-search (file-name-case-insensitive-p dir)))
(dolist (tar-data tar-parse-info)
(let ((name (expand-file-name (tar-header-name tar-data))))
(or (string-match regexp name)
;; Tarballs created by some utilities don't list
;; directories with a trailing slash (Bug#13136).
(and (string-equal dir name)
(eq (tar-header-link-type tar-data) 5))
(error "Package does not untar cleanly into directory %s/" dir)))))
(tar-untar-buffer))
(defun package--alist-to-plist-args (alist)
(mapcar 'macroexp-quote
(apply #'nconc
(mapcar (lambda (pair) (list (car pair) (cdr pair))) alist))))
(defun package-unpack (pkg-desc)
"Install the contents of the current buffer as a package."
(let* ((name (package-desc-name pkg-desc))
(dirname (package-desc-full-name pkg-desc))
(pkg-dir (expand-file-name dirname package-user-dir)))
(pcase (package-desc-kind pkg-desc)
(`dir
(make-directory pkg-dir t)
(let ((file-list
(directory-files
default-directory 'full "\\`[^.].*\\.el\\'" 'nosort)))
(dolist (source-file file-list)
(let ((target-el-file
(expand-file-name (file-name-nondirectory source-file) pkg-dir)))
(copy-file source-file target-el-file t)))
;; Now that the files have been installed, this package is
;; indistinguishable from a `tar' or a `single'. Let's make
;; things simple by ensuring we're one of them.
(setf (package-desc-kind pkg-desc)
(if (> (length file-list) 1) 'tar 'single))))
(`tar
(make-directory package-user-dir t)
;; FIXME: should we delete PKG-DIR if it exists?
(let* ((default-directory (file-name-as-directory package-user-dir)))
(package-untar-buffer dirname)))
(`single
(let ((el-file (expand-file-name (format "%s.el" name) pkg-dir)))
(make-directory pkg-dir t)
(package--write-file-no-coding el-file)))
(kind (error "Unknown package kind: %S" kind)))
(package--make-autoloads-and-stuff pkg-desc pkg-dir)
;; Update package-alist.
(let ((new-desc (package-load-descriptor pkg-dir)))
(unless (equal (package-desc-full-name new-desc)
(package-desc-full-name pkg-desc))
(error "The retrieved package (`%s') doesn't match what the archive offered (`%s')"
(package-desc-full-name new-desc) (package-desc-full-name pkg-desc)))
;; Activation has to be done before compilation, so that if we're
;; upgrading and macros have changed we load the new definitions
;; before compiling.
(when (package-activate-1 new-desc :reload :deps)
;; FIXME: Compilation should be done as a separate, optional, step.
;; E.g. for multi-package installs, we should first install all packages
;; and then compile them.
(package--compile new-desc)
;; After compilation, load again any files loaded by
;; `activate-1', so that we use the byte-compiled definitions.
(package--load-files-for-activation new-desc :reload)))
pkg-dir))
(defun package-generate-description-file (pkg-desc pkg-file)
"Create the foo-pkg.el file for single-file packages."
(let* ((name (package-desc-name pkg-desc)))
(let ((print-level nil)
(print-quoted t)
(print-length nil))
(write-region
(concat
";;; -*- no-byte-compile: t -*-\n"
(prin1-to-string
(nconc
(list 'define-package
(symbol-name name)
(package-version-join (package-desc-version pkg-desc))
(package-desc-summary pkg-desc)
(let ((requires (package-desc-reqs pkg-desc)))
(list 'quote
;; Turn version lists into string form.
(mapcar
(lambda (elt)
(list (car elt)
(package-version-join (cadr elt))))
requires))))
(package--alist-to-plist-args
(package-desc-extras pkg-desc))))
"\n")
nil pkg-file nil 'silent))))
;;;; Autoload
(declare-function autoload-rubric "autoload" (file &optional type feature))
(defun package-autoload-ensure-default-file (file)
"Make sure that the autoload file FILE exists and if not create it."
(unless (file-exists-p file)
(require 'autoload)
(write-region (autoload-rubric file "package" nil) nil file nil 'silent))
file)
(defvar generated-autoload-file)
(defvar autoload-timestamps)
(defvar version-control)
(defun package-generate-autoloads (name pkg-dir)
(let* ((auto-name (format "%s-autoloads.el" name))
;;(ignore-name (concat name "-pkg.el"))
(generated-autoload-file (expand-file-name auto-name pkg-dir))
;; We don't need 'em, and this makes the output reproducible.
(autoload-timestamps nil)
;; Silence `autoload-generate-file-autoloads'.
(noninteractive inhibit-message)
(backup-inhibited t)
(version-control 'never))
(package-autoload-ensure-default-file generated-autoload-file)
(update-directory-autoloads pkg-dir)
(let ((buf (find-buffer-visiting generated-autoload-file)))
(when buf (kill-buffer buf)))
auto-name))
(defun package--make-autoloads-and-stuff (pkg-desc pkg-dir)
"Generate autoloads, description file, etc.. for PKG-DESC installed at PKG-DIR."
(package-generate-autoloads (package-desc-name pkg-desc) pkg-dir)
(let ((desc-file (expand-file-name (package--description-file pkg-dir)
pkg-dir)))
(unless (file-exists-p desc-file)
(package-generate-description-file pkg-desc desc-file)))
;; FIXME: Create foo.info and dir file from foo.texi?
)
;;;; Compilation
(defvar warning-minimum-level)
(defun package--compile (pkg-desc)
"Byte-compile installed package PKG-DESC.
This assumes that `pkg-desc' has already been activated with
`package-activate-1'."
(let ((warning-minimum-level :error)
(save-silently inhibit-message)
(load-path load-path))
(byte-recompile-directory (package-desc-dir pkg-desc) 0 t)))
;;;; Inferring package from current buffer
(defun package-read-from-string (str)
"Read a Lisp expression from STR.
Signal an error if the entire string was not used."
(pcase-let ((`(,expr . ,offset) (read-from-string str)))
(condition-case ()
;; The call to `ignore' suppresses a compiler warning.
(progn (ignore (read-from-string str offset))
(error "Can't read whole string"))
(end-of-file expr))))
(defun package--prepare-dependencies (deps)
"Turn DEPS into an acceptable list of dependencies.
Any parts missing a version string get a default version string
of \"0\" (meaning any version) and an appropriate level of lists
is wrapped around any parts requiring it."
(cond
((not (listp deps))
(error "Invalid requirement specifier: %S" deps))
(t (mapcar (lambda (dep)
(cond
((symbolp dep) `(,dep "0"))
((stringp dep)
(error "Invalid requirement specifier: %S" dep))
((and (listp dep) (null (cdr dep)))
(list (car dep) "0"))
(t dep)))
deps))))