;;; packages.el --- Low level support for XEmacs packages
;; Copyright (C) 1997 Free Software Foundation, Inc.
+;; Copyright (C) 2002, 2003 Ben Wing.
-;; 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 installed 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 "site-packages"))
+ 'early #'(lambda () t))
+ (list (paths-construct-path (list user-init-directory "infodock-packages"))
+ 'early #'(lambda () (featurep 'infodock)))
+ (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."
(defun package-require (name version)
(let ((pkg (assq name packages-package-list)))
(cond ((null pkg)
- (error "Package %s has not been loaded into this XEmacsen"
- name))
+ (error 'invalid-state
+ (format "Package %s has not been loaded into this XEmacsen"
+ name)))
((< (package-get-key name :version) version)
- (error "Need version %g of package %s, got version %g"
- version name (cdr pkg)))
+ (error 'search-failed
+ (format "Need version %g of package %s, got version %g"
+ version name (package-get-key name :version))))
(t t))))
(defun package-delete-name (name)
;; one.
(while (setq pkg (assq name packages-package-list))
(setq packages-package-list (delete pkg (copy-alist
- packages-package-list)))
- )
- ))
+ packages-package-list))))))
;;; Build time stuff
(defvar autoload-file-name "auto-autoloads.el"
"Filename that autoloads are expected to be found in.")
-(defvar packages-hardcoded-lisp
- '(
- ;; Nothing at this time
- )
- "Lisp packages that are always dumped with XEmacs.
-This includes every package that is loaded directly by a package listed
-in dumped-lisp.el and is not itself listed.")
-
-(defvar packages-useful-lisp
- '("bytecomp"
- "byte-optimize"
- "shadow"
- "cl-macs")
- "Lisp packages that need early byte compilation.")
-
-(defvar packages-unbytecompiled-lisp
- '("paths.el"
- "dumped-lisp.el"
- "dumped-pkg-lisp.el"
- "version.el"
- "very-early-lisp.el")
- "Lisp packages that should not be byte compiled.")
-
-
-;; Copied from help.el, could possibly move it to here permanently.
+;; Moved from help.el.
;; Unlike the FSF version, our `locate-library' uses the `locate-file'
;; primitive, which should make it lightning-fast.
If the optional third arg PATH is specified, that list of directories
is used instead of `load-path'."
- (interactive (list (read-string "Locate library: ")
+ (interactive (list (read-library-name "Locate library: ")
nil nil
t))
(let ((result
(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
(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
(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)