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