X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=lisp%2Fpackages.el;h=e0b8fdba63f17fa1c89703c5f3c966a1b931898a;hp=1e374bfb248993f58984773998776def14181c92;hb=02f4d2761a98c5cb9d5b423d2361160a5d8c9ee4;hpb=1c97bf160520f9e0b193236a902eb4b73d59d134 diff --git a/lisp/packages.el b/lisp/packages.el index 1e374bf..e0b8fdb 100644 --- a/lisp/packages.el +++ b/lisp/packages.el @@ -2,8 +2,8 @@ ;; Copyright (C) 1997 Free Software Foundation, Inc. -;; Author: Steven L Baur -;; Maintainer: Steven L Baur +;; Author: Steven L Baur +;; Maintainer: Steven L Baur ;; Keywords: internal, lisp, dumped ;; This file is part of XEmacs. @@ -38,8 +38,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 +55,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.") @@ -84,17 +84,8 @@ (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 +94,16 @@ 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 "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." @@ -123,9 +123,8 @@ the directory to be ignored.") (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))) @@ -191,7 +190,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 @@ -203,8 +202,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 @@ -351,12 +352,12 @@ This function is basically a wrapper over `locate-file'." ;; 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 @@ -419,7 +420,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) @@ -430,7 +431,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 @@ -453,7 +454,7 @@ PACKAGES is a list of package directories. 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))) @@ -495,7 +496,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) @@ -514,7 +515,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 @@ -523,19 +524,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)