cgit.sxemacs.org Git - sxemacs/blob - lisp/packages.el

   1 ;;; packages.el --- Low level support for SXEmacs packages
   2
   3 ;; Copyright (C) 1997 Free Software Foundation, Inc.
   4 ;; Copyright (C) 2002, 2003 Ben Wing.
   5 ;; Copyright (C) 2004 - 2015 Steve Youngs
   6
   7 ;; Author: Steven L Baur <steve@xemacs.org>
   8 ;; Maintainer: Steve Youngs <steve@sxemacs.org>
   9 ;; Keywords: internal, lisp, dumped
  10
  11 ;; This file is part of SXEmacs.
  12
  13 ;; SXEmacs is free software: you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation, either version 3 of the License, or
  16 ;; (at your option) any later version.
  17
  18 ;; SXEmacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  25
  26 ;;; Synched up with: Not in FSF
  27
  28 ;;; Commentary:
  29
  30 ;; This file is dumped with SXEmacs.
  31
  32 ;; This file provides low level facilities for XEmacs startup --
  33 ;; particularly regarding the package setup.  This code has to run in
  34 ;; what we call "bare temacs" -- i.e. XEmacs without the usual Lisp
  35 ;; environment.  Pay special attention:
  36
  37 ;; - not to use the `lambda' macro.  Use #'(lambda ...) instead.
  38 ;;   (this goes for any package loaded before `subr.el'.)
  39 ;;
  40 ;; - not to use macros, because they are not yet available (and this
  41 ;;   file must be loadable uncompiled.)  Built in macros, such as
  42 ;;   `when' and `unless' are fine, of course.
  43 ;;
  44 ;; - not to use `defcustom'.  If you must add user-customizable
  45 ;;   variables here, use `defvar', and add the variable to
  46 ;;   `cus-start.el'.
  47
  48 ;; Because of all this, make sure that the stuff you put here really
  49 ;; belongs here.
  50
  51 ;; This file requires find-paths.el.
  52 \f
  53 ;;; Code:
  54
  55 ;;; Package versioning
  56
  57 (defvar packages-package-list nil
  58   "Database of installed packages and version numbers")
  59
  60 (defvar packages-hierarchy-depth 1
  61   "Depth of package hierarchies.")
  62
  63 (defvar packages-load-path-depth 1
  64   "Depth of load-path search in package hierarchies.")
  65
  66 (defvar packages-data-path-depth 1
  67   "Depth of data-path search in package hierarchies.")
  68
  69 (defvar early-packages nil
  70   "Packages early in the load path.")
  71
  72 (defvar early-package-load-path nil
  73   "Load path for packages early in the load path.")
  74
  75 (defvar late-packages nil
  76   "Packages late in the load path.")
  77
  78 (defvar late-package-load-path nil
  79   "Load path for packages late in the load path.")
  80
  81 (defvar last-packages nil
  82   "Packages last in the load path.")
  83
  84 (defvar last-package-load-path nil
  85   "Load path for packages last in the load path.")
  86
  87 (defun packages-find-user-topdir ()
  88   "Return the top of the user's local package hierachy.
  89
  90 This should be the equivalent of `$XDG_DATA_HOME/sxemacs'.  But will
  91 fall back to the old legacy directory, `~/.sxemacs', if that is the
  92 value of `user-init-directory'.  It may also be in the location set
  93 via the `-user-pkgs-directory' command line arg."
  94   (let* ((legacy (getenv "SXE_USE_LEGACY"))
  95          (xdg (getenv "XDG_DATA_HOME"))
  96          (xdgdir (or (and xdg
  97                           (paths-construct-path `(,xdg "sxemacs")))
  98                      (paths-construct-path
  99                       `(,(user-home-directory)
 100                             ".local" "share" "sxemacs"))))
 101          warndirs)
 102     ;; Set it, if not already.
 103     (when (null user-packages-topdir)
 104       (if (or legacy
 105               (string= (expand-file-name "~/.sxemacs")
 106                        (expand-file-name user-init-directory)))
 107           (setq user-packages-topdir user-init-directory)
 108         (setq user-packages-topdir (file-name-as-directory xdgdir))))
 109     ;; Create if needed.
 110     (unless (paths-file-readable-directory-p user-packages-topdir)
 111       (make-directory-path user-packages-topdir))
 112     ;; Warn if a user has pkg dirs in 2 or more of ~/.sxemacs,
 113     ;; XDG_CONFIG_HOME, XDG_DATA_HOME, but not for symlinked dirs.
 114     (let* ((regexp #r"\(s?xemacs\|site\|mule\)-packages")
 115            (cpkgd (or (and (getenv "XDG_CONFIG_HOME")
 116                            (paths-construct-path
 117                             `(,(getenv "XDG_CONFIG_HOME") "sxemacs")))
 118                       (paths-construct-path
 119                        `(,(user-home-directory) ".config" "sxemacs")))))
 120       ;; ~/.sxemacs
 121       (when (and (not (file-symlink-p "~/.sxemacs"))
 122                  (file-directory-p "~/.sxemacs")
 123                  (directory-files "~/.sxemacs" nil regexp nil 'subdir))
 124         (push "~/.sxemacs" warndirs))
 125       ;; XDG_DATA_HOME
 126       (when (and (not (file-symlink-p xdgdir))
 127                  (file-directory-p xdgdir)
 128                  (directory-files xdgdir nil regexp nil 'subdir))
 129         (push xdgdir warndirs))
 130       ;; XDG_CONFIG_HOME
 131       (when (and (not (file-symlink-p cpkgd))
 132                  (file-directory-p cpkgd)
 133                  (directory-files cpkgd nil regexp nil 'subdir))
 134         (push cpkgd warndirs))
 135       (when (> (length warndirs) 1)
 136         (lwarn 'multi-pkgd nil
 137           "Multiple user package hierarchies detected!!
 138
 139 The following directories contain what appears to be package subdirs:
 140 %S.
 141
 142 Currently in use: `%s'
 143
 144 This, in itself, is not necessarily a problem, but it may mean that
 145 some of your packages won't be visible to this SXEmacs instance.  You
 146 should keep all of your local packages in a single location.
 147
 148 See `display-warning-suppressed-classes' to suppress this warning"
 149           warndirs user-packages-topdir)))
 150     ;; Return the dir
 151     user-packages-topdir))
 152
 153 (defun packages-compute-package-locations (user-packages-topdir)
 154   "Compute locations of the various package directories.
 155
 156 Argument USER-PACKAGES-TOPDIR is the top of the user's local package
 157 hierarchy.  It would normally be the equivalent of
 158 `$XDG_DATA_HOME/sxemacs'.
 159
 160 This is a list, each of whose elements describes one directory.  A
 161 directory description is a three-element list.
 162
 163 The first element is either an absolute path or a subdirectory
 164 in the XEmacs hierarchy.
 165
 166 The second element is one of the symbols EARLY, LATE, LAST,
 167 depending on the load-path segment the hierarchy is supposed to
 168 show up in.
 169
 170 The third element is a thunk which, if it returns NIL, causes the
 171 directory to be ignored."
 172   (list
 173    (list (paths-construct-path (list user-packages-topdir "site-packages"))
 174          'early #'(lambda () t))
 175    (list (paths-construct-path (list user-packages-topdir "sxemacs-packages"))
 176          'early #'(lambda () t))
 177    (list (paths-construct-path (list user-packages-topdir "infodock-packages"))
 178          'early #'(lambda () (featurep 'infodock)))
 179    (list (paths-construct-path (list user-packages-topdir "mule-packages"))
 180          'early #'(lambda () (featurep 'mule)))
 181    (list (paths-construct-path (list user-packages-topdir "xemacs-packages"))
 182          'early #'(lambda () t))
 183    (list "site-packages"     'late  #'(lambda () t))
 184    (list "sxemacs-packages"  'late  #'(lambda () t))
 185    (list "infodock-packages" 'late  #'(lambda () (featurep 'infodock)))
 186    (list "mule-packages"     'late  #'(lambda () (featurep 'mule)))
 187    (list "xemacs-packages"   'late  #'(lambda () t))))
 188
 189 (defun package-get-key-1 (info key)
 190   "Locate keyword `key' in list."
 191   (cond ((null info)
 192          nil)
 193         ((eq (car info) key)
 194          (nth 1 info))
 195         (t (package-get-key-1 (cddr info) key))))
 196
 197 (defun package-get-key (name key)
 198   "Get info `key' from package `name'."
 199   (let ((info (assq name packages-package-list)))
 200     (when info
 201       (package-get-key-1 (cdr info) key))))
 202
 203 (defun package-provide (name &rest attributes)
 204   (let ((info (if (and attributes (floatp (car attributes)))
 205                   (list :version (car attributes))
 206                 attributes)))
 207     (setq packages-package-list
 208           (cons (cons name info) (remassq name packages-package-list)))))
 209
 210 (defun package-suppress (package file form)
 211   "Set up a package-suppress condition FORM for FILE in PACKAGE.
 212 When SXEmacs searches for a file in the load path, it will ignore FILE
 213 if FORM evaluates to non-nil."
 214   (setq load-suppress-alist
 215         (acons (expand-file-name file
 216                                  (file-dirname (expand-file-name load-file-name)))
 217                form
 218                load-suppress-alist)))
 219
 220 (defun package-require (name version)
 221   (let ((pkg (assq name packages-package-list)))
 222     (cond ((null pkg)
 223            (error 'invalid-state
 224                   (format "Package %s has not been loaded into this XEmacsen"
 225                           name)))
 226           ((< (package-get-key name :version) version)
 227            (error 'search-failed
 228                   (format "Need version %g of package %s, got version %g"
 229                           version name (package-get-key name :version))))
 230           (t t))))
 231
 232 (defun package-delete-name (name)
 233   (let (pkg)
 234     ;; Delete ALL versions of package.
 235     ;; This is pretty memory-intensive, as we use copy-alist when deleting
 236     ;; package entries, to prevent side-effects in functions that call this
 237     ;; one.
 238     (while (setq pkg (assq name packages-package-list))
 239       (setq packages-package-list (delete pkg (copy-alist
 240                                                packages-package-list))))))
 241
 242 ;;; Build time stuff
 243
 244 (defvar autoload-file-name "auto-autoloads.el"
 245   "Filename that autoloads are expected to be found in.")
 246
 247 ;; Moved from help.el.
 248 ;; Unlike the FSF version, our `locate-library' uses the `locate-file'
 249 ;; primitive, which should make it lightning-fast.
 250
 251 (defun locate-library (library &optional nosuffix path interactive-call)
 252   "Show the precise file name of Emacs library LIBRARY.
 253 This command searches the directories in `load-path' like `M-x load-library'
 254 to find the file that `M-x load-library RET LIBRARY RET' would load.
 255 Optional second arg NOSUFFIX non-nil means don't add suffixes `.elc' or `.el'
 256 to the specified name LIBRARY.
 257
 258 If the optional third arg PATH is specified, that list of directories
 259 is used instead of `load-path'."
 260   (interactive (list (read-library-name "Locate library: ")
 261                      nil nil
 262                      t))
 263   (let ((result
 264          (locate-file
 265           library
 266           (or path load-path)
 267           (cond ((or (rassq 'jka-compr-handler file-name-handler-alist)
 268                      (and (boundp 'find-file-hooks)
 269                           (member 'crypt-find-file-hook find-file-hooks)))
 270                  ;; Compression involved.
 271                  (if nosuffix
 272                      '("" ".gz" ".Z" ".bz2")
 273                    '(".elc" ".elc.gz" "elc.Z" ".elc.bz2"
 274                      ".el" ".el.gz" ".el.Z" ".el.bz2"
 275                      "" ".gz" ".Z" ".bz2")))
 276                 (t
 277                  ;; No compression.
 278                  (if nosuffix
 279                      ""
 280                    '(".elc" ".el" "")))))))
 281     (and interactive-call
 282          (if result
 283              (message "Library is file %s" result)
 284            (message "No library %s in search path" library)))
 285     result))
 286
 287 (defun packages-add-suffix (str)
 288   (if (null (string-match #r"\.el\'" str))
 289       (concat str ".elc")
 290     str))
 291
 292 (defun packages-list-autoloads-path ()
 293   "List autoloads from precomputed load-path."
 294   (let ((path load-path)
 295         autoloads)
 296     (while path
 297       (if (file-exists-p (concat (car path)
 298                                  autoload-file-name))
 299           (setq autoloads (cons (concat (car path)
 300                                         autoload-file-name)
 301                                 autoloads)))
 302       (setq path (cdr path)))
 303     autoloads))
 304
 305 (defun packages-list-autoloads (source-directory)
 306   "List autoload files in (what will be) the normal lisp search path.
 307 This function is used during build to find where the global symbol files so
 308 they can be perused for their useful information."
 309   (let ((files (directory-files (file-name-as-directory source-directory)
 310                                 t ".*"))
 311         file autolist)
 312     ;; (print (prin1-to-string source-directory))
 313     ;; (print (prin1-to-string files))
 314     (while (setq file (car-safe files))
 315       (if (and (file-directory-p file)
 316                (file-exists-p (concat (file-name-as-directory file)
 317                                       autoload-file-name)))
 318           (setq autolist (cons (concat (file-name-as-directory file)
 319                                        autoload-file-name)
 320                                autolist)))
 321       (setq files (cdr files)))
 322     autolist))
 323
 324 ;; The following function cannot be called from a bare temacs
 325 (defun packages-new-autoloads ()
 326   "Return autoloads files that have been added or modified since XEmacs dump."
 327   (require 'loadhist)
 328   (let ((me (concat invocation-directory invocation-name))
 329         (path load-path)
 330         result dir)
 331     (while path
 332       (setq dir (file-truename (car path)))
 333       (let ((autoload-file (file-name-sans-extension (concat
 334                                                       dir
 335                                                       autoload-file-name))))
 336         ;; Check for:
 337         ;; 1.  An auto-autoload file that hasn't provided a feature (because
 338         ;;     it has been installed since XEmacs was dumped).
 339         ;; 2.  auto-autoload.el being newer than the executable
 340         ;; 3.  auto-autoload.elc being newer than the executable (the .el
 341         ;;     could be missing or compressed)
 342         (when (or (and (null (file-provides autoload-file))
 343                        (or (file-exists-p (concat autoload-file ".elc"))
 344                            (file-exists-p (concat autoload-file ".el"))))
 345                   (and (file-newer-than-file-p (concat autoload-file ".el") me)
 346                        (setq autoload-file (concat autoload-file ".el")))
 347                   (and (file-newer-than-file-p (concat autoload-file
 348                                                        ".elc")
 349                                                me)
 350                        (setq autoload-file (concat autoload-file ".elc"))))
 351           (push autoload-file result)))
 352       (setq path (cdr path)))
 353     result))
 354
 355 ;; The following function cannot be called from a bare temacs
 356 (defun packages-reload-autoloads ()
 357   "Reload new or updated auto-autoloads files.
 358 This is an extremely dangerous function to call after the user-init-files
 359 is run.  Don't call it or you'll be sorry."
 360   (let ((autoload-list (packages-new-autoloads)))
 361     (while autoload-list
 362       (let* ((autoload-file (car autoload-list))
 363              (feature (car-safe (file-provides autoload-file))))
 364         (when feature
 365           ;; (message "(unload-feature %S)" feature)
 366           (unload-feature feature))
 367         (condition-case nil
 368             (load autoload-file)
 369           (t nil)))
 370       (setq autoload-list (cdr autoload-list)))))
 371
 372 ;; Data-directory is really a list now.  Provide something to search it for
 373 ;; directories.
 374
 375 (defun locate-data-directory-list (name &optional dir-list)
 376   "Locate the matching list of directories in a search path DIR-LIST.
 377 If no DIR-LIST is supplied, it defaults to `data-directory-list'."
 378   (unless dir-list
 379     (setq dir-list data-directory-list))
 380   (let (found found-dir found-dir-list)
 381     (while dir-list
 382       (setq found (file-name-as-directory (concat (car dir-list) name))
 383             found-dir (file-directory-p found))
 384       (and found-dir
 385            (setq found-dir-list (cons found found-dir-list)))
 386       (setq dir-list (cdr dir-list)))
 387     (nreverse found-dir-list)))
 388
 389 ;; Data-directory is really a list now.  Provide something to search it for
 390 ;; a directory.
 391
 392 (defun locate-data-directory (name &optional dir-list)
 393   "Locate a directory in a search path DIR-LIST (a list of directories).
 394 If no DIR-LIST is supplied, it defaults to `data-directory-list'."
 395   (unless dir-list
 396     (setq dir-list data-directory-list))
 397   (let (found found-dir)
 398     (while (and (null found-dir) dir-list)
 399       (setq found (file-name-as-directory (concat (car dir-list) name))
 400             found-dir (file-directory-p found))
 401       (or found-dir
 402           (setq found nil))
 403       (setq dir-list (cdr dir-list)))
 404     found))
 405
 406 ;; Data-directory is really a list now.  Provide something to search it for
 407 ;; files.
 408
 409 (defun locate-data-file (name &optional dir-list)
 410   "Locate a file in a search path DIR-LIST (a list of directories).
 411 If no DIR-LIST is supplied, it defaults to `data-directory-list'.
 412 This function is basically a wrapper over `locate-file'."
 413   (locate-file name (or dir-list data-directory-list)))
 414
 415 ;; Path setup
 416
 417 (defun packages-find-package-directories (roots base)
 418   "Find a set of package directories."
 419   ;; make sure paths-find-version-directory and paths-find-site-directory
 420   ;; don't both pick up version-independent directories ...
 421   (let ((version-directory (paths-find-version-archindep-directory
 422                             roots base nil nil t))
 423         (site-directory (paths-find-site-archindep-directory roots base)))
 424     (paths-uniq-append
 425      (and version-directory (list version-directory))
 426      (and site-directory (list site-directory)))))
 427
 428 (defvar packages-special-base-regexp #r"^\(etc\|info\|man\|lisp\|lib-src\|bin\|pkginfo\)$"
 429   "Special subdirectories of packages.")
 430
 431 (defvar packages-no-package-hierarchy-regexp
 432   (concat "\\(" paths-version-control-filename-regexp "\\)"
 433           "\\|"
 434           "\\(" packages-special-base-regexp "\\)")
 435   "Directories which can't be the roots of package hierarchies.")
 436
 437 (defun packages-find-packages-in-directories (directories)
 438   "Find all packages underneath directories in DIRECTORIES."
 439   (paths-find-recursive-path directories
 440                              packages-hierarchy-depth
 441                              packages-no-package-hierarchy-regexp))
 442
 443 (defun packages-split-path (path)
 444   "Split PATH at \"\", return pair with two components.
 445 The second component is shared with PATH."
 446   (let ((reverse-tail '())
 447         (rest path))
 448     (while (and rest (null (string-equal "" (car rest))))
 449       (setq reverse-tail (cons (car rest) reverse-tail))
 450       (setq rest (cdr rest)))
 451     (if (null rest)
 452         (cons path nil)
 453       (cons (nreverse reverse-tail) (cdr rest)))))
 454
 455 (defun packages-split-package-path (package-path)
 456   "Split up PACKAGE-PATH into early, late and last components.
 457 The separation is by \"\" components.
 458 This returns (LIST EARLY-PACKAGES LATE-PACKAGES LAST-PACKAGES)."
 459   ;; When in doubt, it's late
 460   (let* ((stuff (packages-split-path package-path))
 461          (early (and (cdr stuff) (car stuff)))
 462          (late+last (or (cdr stuff) (car stuff)))
 463          (stuff (packages-split-path late+last))
 464          (late (car stuff))
 465          (last (cdr stuff)))
 466     (list (packages-find-packages-in-directories early)
 467           (packages-find-packages-in-directories late)
 468           (packages-find-packages-in-directories last))))
 469
 470 (defun packages-deconstruct (list consumer)
 471   "Deconstruct LIST and feed it to CONSUMER."
 472   (apply consumer list))
 473
 474 (defun packages-find-packages-by-name (roots name)
 475   "Find a package hierarchy by its name."
 476   (packages-find-packages-in-directories
 477    (if (and (file-name-absolute-p name)
 478             (file-name-directory (expand-file-name name)))
 479        (list (file-name-as-directory (expand-file-name name)))
 480     (packages-find-package-directories roots name))))
 481
 482 (defun packages-find-packages-at-time
 483   (roots package-locations time &optional default)
 484   "Find packages at given time.
 485 For the format of PACKAGE-LOCATIONS, see the global variable of the same name.
 486 TIME is either 'EARLY, 'LATE, or 'LAST.
 487 DEFAULT is a default list of packages."
 488   (or default
 489       (let ((packages '()))
 490         (while package-locations
 491           (packages-deconstruct
 492            (car package-locations)
 493            #'(lambda (name a-time thunk)
 494                (if (and (eq time a-time)
 495                         (funcall thunk))
 496                    (setq packages
 497                          (nconc packages
 498                                 (packages-find-packages-by-name roots name))))))
 499           (setq package-locations (cdr package-locations)))
 500         packages)))
 501
 502 (defun packages-find-packages (roots package-locations)
 503   "Find the packages."
 504   (let ((envvar-value (getenv "EMACSPACKAGEPATH")))
 505     (if envvar-value
 506         (packages-split-package-path (paths-decode-directory-path envvar-value))
 507       (packages-deconstruct
 508        (packages-split-package-path configure-package-path)
 509        #'(lambda (configure-early-packages
 510                   configure-late-packages
 511                   configure-last-packages)
 512            (list (packages-find-packages-at-time roots package-locations 'early
 513                                                  configure-early-packages)
 514                  (packages-find-packages-at-time roots package-locations 'late
 515                                                  configure-late-packages)
 516                  (packages-find-packages-at-time roots package-locations 'last
 517                                                  configure-last-packages)))))))
 518
 519 (defun packages-find-package-library-path (packages suffixes)
 520   "Construct a path into a component of the packages hierarchy.
 521 PACKAGES is a list of package directories.
 522 SUFFIXES is a list of names of package subdirectories to look for."
 523   (let ((directories
 524          (apply
 525           #'nconc
 526           (mapcar #'(lambda (package)
 527                       (mapcar #'(lambda (suffix)
 528                                   (file-name-as-directory (concat package suffix)))
 529                               suffixes))
 530                   packages))))
 531     (paths-directories-which-exist directories)))
 532
 533 (defun packages-find-package-load-path (packages)
 534   "Construct the load-path component for packages.
 535 PACKAGES is a list of package directories."
 536   (paths-find-recursive-load-path
 537    (packages-find-package-library-path packages
 538                                        '("lisp"))
 539    packages-load-path-depth))
 540
 541 (defun packages-find-package-exec-path (packages)
 542   "Construct the exec-path component for packages.
 543 PACKAGES is a list of package directories."
 544   (packages-find-package-library-path packages
 545                                       (list (paths-construct-path
 546                                              (list "bin" system-configuration))
 547                                             "lib-src")))
 548
 549 (defun packages-find-package-info-path (packages)
 550   "Construct the info-path component for packages.
 551 PACKAGES is a list of package directories."
 552   (packages-find-package-library-path packages '("info")))
 553
 554 (defun packages-find-package-data-path (packages)
 555   "Construct the data-path component for packages.
 556 PACKAGES is a list of package directories."
 557   (paths-find-recursive-load-path
 558    (packages-find-package-library-path packages
 559                                        '("etc"))
 560    packages-data-path-depth))
 561
 562 ;; Loading package initialization files
 563
 564 (defun packages-load-package-lisps (package-load-path base)
 565   "Load all Lisp files of a certain name along a load path.
 566 BASE is the base name of the files."
 567   (mapcar #'(lambda (dir)
 568             (let ((file-name (expand-file-name base dir)))
 569               (condition-case error
 570                   (load file-name t t)
 571                 (error
 572                  (warn (format "Autoload error in: %s:\n\t%s"
 573                                file-name
 574                                (with-output-to-string
 575                                  (display-error error nil))))))))
 576         package-load-path))
 577
 578 (defun packages-load-package-auto-autoloads (package-load-path)
 579   "Load auto-autoload files along a load path."
 580   (packages-load-package-lisps package-load-path
 581                                (file-name-sans-extension autoload-file-name)))
 582
 583 (defun packages-handle-package-dumped-lisps (handle package-load-path)
 584   "Load dumped-lisp.el files along a load path.
 585 Call HANDLE on each file off definitions of PACKAGE-LISP there."
 586   (mapcar #'(lambda (dir)
 587             (let ((file-name (expand-file-name "dumped-lisp.el" dir)))
 588               (if (file-exists-p file-name)
 589                   (let (package-lisp
 590                         ;; 20.4 packages could set this
 591                         preloaded-file-list)
 592                     (load file-name)
 593                     ;; dumped-lisp.el could have set this ...
 594                     (if package-lisp
 595                         (mapcar #'(lambda (base)
 596                                   (funcall handle base))
 597                               package-lisp))))))
 598         package-load-path))
 599
 600 (defun packages-load-package-dumped-lisps (package-load-path)
 601   "Load dumped-lisp.el files along a load path.
 602 Also load files off PACKAGE-LISP definitions there."
 603   (packages-handle-package-dumped-lisps #'load package-load-path))
 604
 605 (defun packages-collect-package-dumped-lisps (package-load-path)
 606   "Load dumped-lisp.el files along a load path.
 607 Return list of files off PACKAGE-LISP definitions there."
 608   (let ((*files* '()))
 609     (packages-handle-package-dumped-lisps
 610      #'(lambda (file)
 611          (setq *files* (cons file *files*)))
 612      package-load-path)
 613     (reverse *files*)))
 614
 615 (provide 'packages)
 616
 617 ;;; packages.el ends here