Mercurial > hg > xemacs-beta

comparison lisp/packages.el @ 2456:f4e405a9d18d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2004-12-27 12:25:14 by michaels] 2004-12-18 Mike Sperber <mike@xemacs.org> * package-admin.el: * startup.el: Reflect the changes made in packages.el. * packages.el: * loadup.el: * make-docfile.el: * package-admin.el: * startup.el: * update-elc.el (early-package-hierarchies) (late-package-hierarchies) (last-package-hierarchies): Renamed these from `early-packages', `late-packages' and `last-packages'. * packages.el: Rewrote package-finding logic to separate the concepts of "package directories" and "package hierarchies". Added explanation of these concepts. * setup-paths.el: * find-paths.el: Added parameter descriptions to some of the docstrings. * packages.el, setup-paths.el: Make terminology more explicit about "package hierarchies" * startup.el (emacs-roots, emacs-data-roots) (user-init-directory-base, user-init-directory) (user-init-file-base, user-init-file-base-list) (user-home-init-file-base-list) (load-home-init-file, load-user-init-file-p) (startup-find-load-path, startup-setup-paths) (startup-find-load-path-for-packages): Moved these back from setup-paths.el where they belong---setup-paths.el now again, as documented, contains no code that sets global variables. (They were moved from startup.el to setup-paths.el on 2003-02-28.) Clarify that in the comment at the top. * setup-paths.el (paths-find-emacs-roots): Restored `invocation-directory' 'invocation-name' parameters removed on 2003-02-28; they're useful for debugging.
author michaels
date Mon, 27 Dec 2004 12:27:05 +0000
parents cd15d235fdeb
children 505a24c07ba9
comparison
equal deleted inserted replaced
2455:3e06061baa0e 2456:f4e405a9d18d
56 ;;; Package versioning 56 ;;; Package versioning
57 57
58 (defvar packages-package-list nil 58 (defvar packages-package-list nil
59 "Database of installed packages and version numbers") 59 "Database of installed packages and version numbers")
60 60
61 (defvar packages-hierarchy-depth 1 61 ;;; Directories and paths
62 "Depth of package hierarchies.") 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.
63 80
64 (defvar packages-load-path-depth 1 81 (defvar packages-load-path-depth 1
65 "Depth of load-path search in package hierarchies.") 82 "Depth of load-path search in package hierarchies.")
66 83
67 (defvar packages-data-path-depth 1 84 (defvar packages-data-path-depth 1
68 "Depth of data-path search in package hierarchies.") 85 "Depth of data-path search in package hierarchies.")
69 86
70 (defvar early-packages nil 87 (defvar early-package-hierarchies nil
71 "Packages early in the load path.") 88 "Package hierarchies early in the load path.")
72 89
73 (defvar early-package-load-path nil 90 (defvar early-package-load-path nil
74 "Load path for packages early in the load path.") 91 "Load path for packages early in the load path.")
75 92
76 (defvar late-packages nil 93 (defvar late-package-hierarchies nil
77 "Packages late in the load path.") 94 "Package hierarchies late in the load path.")
78 95
79 (defvar late-package-load-path nil 96 (defvar late-package-load-path nil
80 "Load path for packages late in the load path.") 97 "Load path for packages late in the load path.")
81 98
82 (defvar last-packages nil 99 (defvar last-package-hierarchies nil
83 "Packages last in the load path.") 100 "Package hierarchies last in the load path.")
84 101
85 (defvar last-package-load-path nil 102 (defvar last-package-load-path nil
86 "Load path for packages last in the load path.") 103 "Load path for packages last in the load path.")
87 104
88 (defun packages-compute-package-locations (user-init-directory) 105 (defun packages-package-hierarchy-directory-names ()
89 "Compute locations of the various package directories. 106 "Returns a list package hierarchy directory names.
90 This is a list each of whose elements describes one directory. 107 These are the valid immediate directory names of package
91 A directory description is a three-element list. 108 directories, directories with higher priority first"
92 The first element is either an absolute path or a subdirectory 109 (paths-filter #'(lambda (x) x)
93 in the XEmacs hierarchy. 110 `("site-packages"
94 The second component is one of the symbols EARLY, LATE, LAST, 111 ,(when (featurep 'infodock) "infodock-packages")
95 depending on the load-path segment the hierarchy is supposed to 112 ,(when (featurep 'mule) "mule-packages")
96 show up in. 113 "xemacs-packages")))
97 The third component is a thunk which, if it returns NIL, causes
98 the directory to be ignored."
99 (list
100 (list (paths-construct-path (list user-init-directory "site-packages"))
101 'early #'(lambda () t))
102 (list (paths-construct-path (list user-init-directory "infodock-packages"))
103 'early #'(lambda () (featurep 'infodock)))
104 (list (paths-construct-path (list user-init-directory "mule-packages"))
105 'early #'(lambda () (featurep 'mule)))
106 (list (paths-construct-path (list user-init-directory "xemacs-packages"))
107 'early #'(lambda () t))
108 (list "site-packages" 'late #'(lambda () t))
109 (list "infodock-packages" 'late #'(lambda () (featurep 'infodock)))
110 (list "mule-packages" 'late #'(lambda () (featurep 'mule)))
111 (list "xemacs-packages" 'late #'(lambda () t))))
112 114
113 (defun package-get-key-1 (info key) 115 (defun package-get-key-1 (info key)
114 "Locate keyword `key' in list." 116 "Locate keyword `key' in list."
115 (cond ((null info) 117 (cond ((null info)
116 nil) 118 nil)
326 This function is basically a wrapper over `locate-file'." 328 This function is basically a wrapper over `locate-file'."
327 (locate-file name (or dir-list data-directory-list))) 329 (locate-file name (or dir-list data-directory-list)))
328 330
329 ;; Path setup 331 ;; Path setup
330 332
331 (defun packages-find-package-directories (roots base) 333 (defun packages-find-package-hierarchies-named (package-directories base)
332 "Find a set of package directories." 334 "Find a set of package hierarchies within an XEmacs installation.
333 ;; make sure paths-find-version-directory and paths-find-site-directory 335 PACKAGE-DIRECTORIES is a list of package directories.
334 ;; don't both pick up version-independent directories ... 336 BASE is a subdirectory name for the hierarchy.
335 (let ((version-directory (paths-find-version-directory roots base nil nil t)) 337 Returns list of hierarchies."
336 (site-directory (paths-find-site-directory roots base))) 338 (paths-directories-which-exist
337 (paths-uniq-append 339 (mapcar #'(lambda (package-directory)
338 (and version-directory (list version-directory)) 340 (file-name-as-directory (concat package-directory base)))
339 (and site-directory (list site-directory))))) 341 package-directories)))
340
341 (defvar packages-special-base-regexp "^\\(etc\\|info\\|man\\|lisp\\|lib-src\\|bin\\|pkginfo\\)$"
342 "Special subdirectories of packages.")
343
344 (defvar packages-no-package-hierarchy-regexp
345 (concat "\\(" paths-version-control-filename-regexp "\\)"
346 "\\|"
347 "\\(" packages-special-base-regexp "\\)")
348 "Directories which can't be the roots of package hierarchies.")
349
350 (defun packages-find-packages-in-directories (directories)
351 "Find all packages underneath directories in DIRECTORIES."
352 (paths-find-recursive-path directories
353 packages-hierarchy-depth
354 packages-no-package-hierarchy-regexp))
355 342
356 (defun packages-split-path (path) 343 (defun packages-split-path (path)
357 "Split PATH at \"\", return pair with two components. 344 "Split PATH at \"\", return pair with two components.
358 The second component is shared with PATH." 345 The second component is shared with PATH."
359 (let ((reverse-tail '()) 346 (let ((reverse-tail '())
366 (cons (nreverse reverse-tail) (cdr rest))))) 353 (cons (nreverse reverse-tail) (cdr rest)))))
367 354
368 (defun packages-split-package-path (package-path) 355 (defun packages-split-package-path (package-path)
369 "Split up PACKAGE-PATH into early, late and last components. 356 "Split up PACKAGE-PATH into early, late and last components.
370 The separation is by \"\" components. 357 The separation is by \"\" components.
371 This returns (LIST EARLY-PACKAGES LATE-PACKAGES LAST-PACKAGES)." 358 This returns
359 (LIST EARLY-PACKAGE-HIERARCHIES LATE-PACKAGE-HIERARCHIES LAST-PACKAGE-HIERARCHIES)."
372 ;; When in doubt, it's late 360 ;; When in doubt, it's late
373 (let* ((stuff (packages-split-path package-path)) 361 (let* ((stuff (packages-split-path package-path))
374 (early (and (cdr stuff) (car stuff))) 362 (early (and (cdr stuff) (car stuff)))
375 (late+last (or (cdr stuff) (car stuff))) 363 (late+last (or (cdr stuff) (car stuff)))
376 (stuff (packages-split-path late+last)) 364 (stuff (packages-split-path late+last))
377 (late (car stuff)) 365 (late (car stuff))
378 (last (cdr stuff))) 366 (last (cdr stuff)))
379 (list (packages-find-packages-in-directories early) 367 (list (mapcar #'file-name-as-directory early)
380 (packages-find-packages-in-directories late) 368 (mapcar #'file-name-as-directory late)
381 (packages-find-packages-in-directories last)))) 369 (mapcar #'file-name-as-directory last))))
382 370
383 (defun packages-deconstruct (list consumer) 371 (defun packages-deconstruct (list consumer)
384 "Deconstruct LIST and feed it to CONSUMER." 372 "Deconstruct LIST and feed it to CONSUMER.
373 CONSUMER is a function that accepts the elements of LISTS as separate arguments."
385 (apply consumer list)) 374 (apply consumer list))
386 375
387 (defun packages-find-packages-by-name (roots name) 376 (defun packages-find-installation-package-directories (roots)
388 "Find a package hierarchy by its name." 377 "Find the package directories in the XEmacs installation.
389 (packages-find-packages-in-directories 378 ROOTS is a list of installation roots."
390 (if (and (file-name-absolute-p name) 379 (let ((version-directory (paths-find-version-directory roots "" nil nil t))
391 (file-name-directory (expand-file-name name))) 380 (site-directory (paths-find-site-directory roots "")))
392 (list (file-name-as-directory (expand-file-name name))) 381 (paths-uniq-append
393 (packages-find-package-directories roots name)))) 382 (and version-directory (list version-directory))
394 383 (and site-directory (list site-directory)))))
395 (defun packages-find-packages-at-time 384
396 (roots package-locations time &optional default) 385 (defun packages-find-package-hierarchies (package-directories &optional default)
397 "Find packages at given time. 386 "Find package hierarchies in a list of package directories.
398 For the format of PACKAGE-LOCATIONS, see the global variable of the same name. 387 PACKAGE-DIRECTORIES is a list of package directories.
399 TIME is either 'EARLY, 'LATE, or 'LAST. 388 DEFAULT is a default list of package hierarchies."
400 DEFAULT is a default list of packages."
401 (or default 389 (or default
402 (let ((packages '())) 390 (let ((package-hierarchies '())
403 (while package-locations 391 (hierarchy-directories (packages-package-hierarchy-directory-names)))
404 (packages-deconstruct 392 (while hierarchy-directories
405 (car package-locations) 393 (setq package-hierarchies
406 #'(lambda (name a-time thunk) 394 (nconc package-hierarchies
407 (if (and (eq time a-time) 395 (packages-find-package-hierarchies-named
408 (funcall thunk)) 396 package-directories
409 (setq packages 397 (car hierarchy-directories))))
410 (nconc packages 398 (setq hierarchy-directories (cdr hierarchy-directories)))
411 (packages-find-packages-by-name roots name)))))) 399 package-hierarchies)))
412 (setq package-locations (cdr package-locations))) 400
413 packages))) 401 (defun packages-find-all-package-hierarchies (roots)
414 402 "Find the package hierarchies.
415 (defun packages-find-packages (roots package-locations) 403 ROOTS is a list of installation roots.
416 "Find the packages." 404 Returns a list of three directory lists, the first being the list of early
405 hierarchies, the second that of the late hierarchies, and the third the
406 list of the last hierarchies."
417 (let ((envvar-value (getenv "EMACSPACKAGEPATH"))) 407 (let ((envvar-value (getenv "EMACSPACKAGEPATH")))
418 (if envvar-value 408 (if envvar-value
419 (packages-split-package-path (paths-decode-directory-path envvar-value)) 409 (packages-split-package-path (paths-decode-directory-path envvar-value))
420 (packages-deconstruct 410 (packages-deconstruct
421 (packages-split-package-path configure-package-path) 411 (packages-split-package-path configure-package-path)
422 #'(lambda (configure-early-packages 412 #'(lambda (configure-early-package-hierarchies
423 configure-late-packages 413 configure-late-package-hierarchies
424 configure-last-packages) 414 configure-last-package-hierarchies)
425 (list (packages-find-packages-at-time roots package-locations 'early 415 (list
426 configure-early-packages) 416 (packages-find-package-hierarchies (list user-init-directory)
427 (packages-find-packages-at-time roots package-locations 'late 417 configure-early-package-hierarchies)
428 configure-late-packages) 418 (packages-find-package-hierarchies (packages-find-installation-package-directories roots)
429 (packages-find-packages-at-time roots package-locations 'last 419 configure-late-package-hierarchies)
430 configure-last-packages))))))) 420 (packages-find-package-hierarchies '()
431 421 configure-last-package-hierarchies)))))))
432 (defun packages-find-package-library-path (packages suffixes) 422
423 (defun packages-find-package-library-path (package-hierarchies suffixes)
433 "Construct a path into a component of the packages hierarchy. 424 "Construct a path into a component of the packages hierarchy.
434 PACKAGES is a list of package directories. 425 PACKAGE-HIERARCHIES is a list of package hierarchies.
435 SUFFIXES is a list of names of package subdirectories to look for." 426 SUFFIXES is a list of names of hierarchy subdirectories to look for."
436 (let ((directories 427 (let ((directories
437 (apply 428 (apply
438 #'nconc 429 #'nconc
439 (mapcar #'(lambda (package) 430 (mapcar #'(lambda (hierarchy)
440 (mapcar #'(lambda (suffix) 431 (mapcar #'(lambda (suffix)
441 (file-name-as-directory (concat package suffix))) 432 (file-name-as-directory (concat hierarchy suffix)))
442 suffixes)) 433 suffixes))
443 packages)))) 434 package-hierarchies))))
444 (paths-directories-which-exist directories))) 435 (paths-directories-which-exist directories)))
445 436
446 (defun packages-find-package-load-path (packages) 437 (defun packages-find-package-load-path (package-hierarchies)
447 "Construct the load-path component for packages. 438 "Construct the load-path component for packages.
448 PACKAGES is a list of package directories." 439 PACKAGE-HIERARCHIES is a list of package hierarchies."
449 (paths-find-recursive-load-path 440 (paths-find-recursive-load-path
450 (packages-find-package-library-path packages 441 (packages-find-package-library-path package-hierarchies
451 '("lisp")) 442 '("lisp"))
452 packages-load-path-depth)) 443 packages-load-path-depth))
453 444
454 (defun packages-find-package-exec-path (packages) 445 (defun packages-find-package-exec-path (package-hierarchies)
455 "Construct the exec-path component for packages. 446 "Construct the exec-path component for packages.
456 PACKAGES is a list of package directories." 447 PACKAGE-HIERARCHIES is a list of package hierarchies."
457 (packages-find-package-library-path packages 448 (packages-find-package-library-path package-hierarchies
458 (list (paths-construct-path 449 (list (paths-construct-path
459 (list "bin" system-configuration)) 450 (list "bin" system-configuration))
460 "lib-src"))) 451 "lib-src")))
461 452
462 (defun packages-find-package-info-path (packages) 453 (defun packages-find-package-info-path (package-hierarchies)
463 "Construct the info-path component for packages. 454 "Construct the info-path component for packages.
464 PACKAGES is a list of package directories." 455 PACKAGE-HIERARCHIES is a list of package directories."
465 (packages-find-package-library-path packages '("info"))) 456 (packages-find-package-library-path package-hierarchies '("info")))
466 457
467 (defun packages-find-package-data-path (packages) 458 (defun packages-find-package-data-path (package-hierarchies)
468 "Construct the data-path component for packages. 459 "Construct the data-path component for packages.
469 PACKAGES is a list of package directories." 460 PACKAGE-HIERARCHIES is a list of package hierachies."
470 (paths-find-recursive-load-path 461 (paths-find-recursive-load-path
471 (packages-find-package-library-path packages 462 (packages-find-package-library-path package-hierarchies
472 '("etc")) 463 '("etc"))
473 packages-data-path-depth)) 464 packages-data-path-depth))
474 465
475 ;; Loading package initialization files 466 ;; Loading package initialization files
476 467