;; Copyright (C) 1997 Free Software Foundation, Inc.
-;; Author: Steven L Baur <steve@altair.xemacs.org>
-;; Maintainer: Steven L Baur <steve@altair.xemacs.org>
+;; Author: Steven L Baur <steve@xemacs.org>
+;; Maintainer: Steven L Baur <steve@xemacs.org>
;; Keywords: internal, lisp, dumped
;; This file is part of XEmacs.
;; (this goes for any package loaded before `subr.el'.)
;;
;; - not to use macros, because they are not yet available (and this
-;; file must be loadable uncompiled.) This rules out CL-style
-;; macros like `when', for instance.
+;; file must be loadable uncompiled.) Built in macros, such as
+;; `when' and `unless' are fine, of course.
;;
;; - not to use `defcustom'. If you must add user-customizable
;; variables here, use `defvar', and add the variable to
;;; Package versioning
(defvar packages-package-list nil
- "database of loaded packages and version numbers")
+ "Database of loaded packages and version numbers")
(defvar packages-hierarchy-depth 1
"Depth of package hierarchies.")
(defvar last-package-load-path nil
"Load path for packages last in the load path.")
-(defvar package-locations
- (list
- (list (paths-construct-path '("~" ".xemacs" "mule-packages"))
- 'early #'(lambda () (featurep 'mule)))
- (list (paths-construct-path '("~" ".xemacs" "xemacs-packages"))
- 'early #'(lambda () t))
- (list "site-packages" 'late #'(lambda () t))
- (list "infodock-packages" 'late #'(lambda () (featurep 'infodock)))
- (list "mule-packages" 'late #'(lambda () (featurep 'mule)))
- (list "xemacs-packages" 'late #'(lambda () t)))
- "Locations of the various package directories.
+(defun packages-compute-package-locations (user-init-directory)
+ "Compute locations of the various package directories.
This is a list each of whose elements describes one directory.
A directory description is a three-element list.
The first element is either an absolute path or a subdirectory
depending on the load-path segment the hierarchy is supposed to
show up in.
The third component is a thunk which, if it returns NIL, causes
-the directory to be ignored.")
+the directory to be ignored."
+ (list
+ (list (paths-construct-path (list user-init-directory "mule-packages"))
+ 'early #'(lambda () (featurep 'mule)))
+ (list (paths-construct-path (list user-init-directory "xemacs-packages"))
+ 'early #'(lambda () t))
+ (list "site-packages" 'late #'(lambda () t))
+ (list "infodock-packages" 'late #'(lambda () (featurep 'infodock)))
+ (list "mule-packages" 'late #'(lambda () (featurep 'mule)))
+ (list "xemacs-packages" 'late #'(lambda () t))))
(defun package-get-key-1 (info key)
"Locate keyword `key' in list."
(let ((info (if (and attributes (floatp (car attributes)))
(list :version (car attributes))
attributes)))
- (remassq name packages-package-list)
(setq packages-package-list
- (cons (cons name info) packages-package-list))))
+ (cons (cons name info) (remassq name packages-package-list)))))
(defun package-require (name version)
(let ((pkg (assq name packages-package-list)))
(member 'crypt-find-file-hook find-file-hooks)))
;; Compression involved.
(if nosuffix
- '("" ".gz" ".Z")
- '(".elc" ".elc.gz" "elc.Z" ".el" ".el.gz" ".el.Z" "" ".gz" ".Z")))
+ '("" ".gz" ".Z" ".bz2")
+ '(".elc" ".elc.gz" "elc.Z" ".elc.bz2"
+ ".el" ".el.gz" ".el.Z" ".el.bz2"
+ "" ".gz" ".Z" ".bz2")))
(t
;; No compression.
(if nosuffix
;; make sure paths-find-version-directory and paths-find-site-directory
;; don't both pick up version-independent directories ...
(let ((version-directory (paths-find-version-directory roots base nil nil t))
- (site-directory (paths-find-site-directory roots base)))
+ (site-directory (paths-find-site-directory roots base nil nil t)))
(paths-uniq-append
(and version-directory (list version-directory))
(and site-directory (list site-directory)))))
-(defvar packages-special-base-regexp "^\\(etc\\|info\\|lisp\\|lib-src\\|bin\\|pkginfo\\)$"
+(defvar packages-special-base-regexp "^\\(etc\\|info\\|man\\|lisp\\|lib-src\\|bin\\|pkginfo\\)$"
"Special subdirectories of packages.")
(defvar packages-no-package-hierarchy-regexp
(or default
(let ((packages '()))
(while package-locations
- (packages-deconstruct
+ (packages-deconstruct
(car package-locations)
#'(lambda (name a-time thunk)
(if (and (eq time a-time)
(setq package-locations (cdr package-locations)))
packages)))
-(defun packages-find-packages (roots)
+(defun packages-find-packages (roots package-locations)
"Find the packages."
(let ((envvar-value (getenv "EMACSPACKAGEPATH")))
(if envvar-value
SUFFIXES is a list of names of package subdirectories to look for."
(let ((directories
(apply
- #'append
+ #'nconc
(mapcar #'(lambda (package)
(mapcar #'(lambda (suffix)
(file-name-as-directory (concat package suffix)))
(defun packages-load-package-lisps (package-load-path base)
"Load all Lisp files of a certain name along a load path.
BASE is the base name of the files."
- (mapc #'(lambda (dir)
+ (mapcar #'(lambda (dir)
(let ((file-name (expand-file-name base dir)))
(condition-case error
(load file-name t t)
(defun packages-handle-package-dumped-lisps (handle package-load-path)
"Load dumped-lisp.el files along a load path.
Call HANDLE on each file off definitions of PACKAGE-LISP there."
- (mapc #'(lambda (dir)
+ (mapcar #'(lambda (dir)
(let ((file-name (expand-file-name "dumped-lisp.el" dir)))
(if (file-exists-p file-name)
(let (package-lisp
(load file-name)
;; dumped-lisp.el could have set this ...
(if package-lisp
- (mapc #'(lambda (base)
+ (mapcar #'(lambda (base)
(funcall handle base))
package-lisp))))))
package-load-path))
(defun packages-load-package-dumped-lisps (package-load-path)
"Load dumped-lisp.el files along a load path.
-Also load files off PACKAGE-LISP definitions there"
+Also load files off PACKAGE-LISP definitions there."
(packages-handle-package-dumped-lisps #'load package-load-path))
(defun packages-collect-package-dumped-lisps (package-load-path)
"Load dumped-lisp.el files along a load path.
-Return list of files off PACKAGE-LISP definitions there"
+Return list of files off PACKAGE-LISP definitions there."
(let ((*files* '()))
(packages-handle-package-dumped-lisps
#'(lambda (file)