(g2-UU+5B73): Add `=decomposition@hanyo-denshi'.
[chise/xemacs-chise.git.1] / lisp / packages.el
index 03d001b..7c7fd97 100644 (file)
@@ -1,9 +1,10 @@
 ;;; 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.
@@ -38,8 +39,8 @@
 ;;   (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
@@ -55,7 +56,7 @@
 ;;; 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
@@ -103,7 +95,20 @@ The second component is one of the symbols EARLY, LATE, LAST,
 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."
@@ -129,11 +134,13 @@ the directory to be ignored.")
 (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)
@@ -144,40 +151,14 @@ the directory to be ignored.")
     ;; 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.
 
@@ -190,7 +171,7 @@ to the specified name LIBRARY.
 
 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
@@ -202,8 +183,10 @@ is used instead of `load-path'."
                          (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
@@ -355,7 +338,7 @@ This function is basically a wrapper over `locate-file'."
      (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
@@ -418,7 +401,7 @@ DEFAULT is a default list of packages."
   (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)
@@ -429,7 +412,7 @@ DEFAULT is a default list of packages."
          (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
@@ -494,7 +477,7 @@ PACKAGES is a list of package directories."
 (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)
@@ -513,7 +496,7 @@ BASE is the base name of the files."
 (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
@@ -522,19 +505,19 @@ Call HANDLE on each file off definitions of PACKAGE-LISP there."
                    (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)