Mercurial > hg > xemacs-beta

comparison lisp/packages.el @ 398:74fd4e045ea6 r21-2-29

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-29
author cvs
date Mon, 13 Aug 2007 11:13:30 +0200
parents 6240c7796c7a
children 501cfd01ee6d
comparison
equal deleted inserted replaced
397:f4aeb21a5bad 398:74fd4e045ea6
1 ;;; packages.el --- Low level support for XEmacs packages 1 ;;; packages.el --- Low level support for XEmacs packages
2 2
3 ;; Copyright (C) 1997 Free Software Foundation, Inc. 3 ;; Copyright (C) 1997 Free Software Foundation, Inc.
4 4
5 ;; Author: Steven L Baur <steve@altair.xemacs.org> 5 ;; Author: Steven L Baur <steve@xemacs.org>
6 ;; Maintainer: Steven L Baur <steve@altair.xemacs.org> 6 ;; Maintainer: Steven L Baur <steve@xemacs.org>
7 ;; Keywords: internal, lisp, dumped 7 ;; Keywords: internal, lisp, dumped
8 8
9 ;; This file is part of XEmacs. 9 ;; This file is part of XEmacs.
10 10
11 ;; XEmacs is free software; you can redistribute it and/or modify it 11 ;; XEmacs is free software; you can redistribute it and/or modify it
53 ;;; Code: 53 ;;; Code:
54 54
55 ;;; Package versioning 55 ;;; Package versioning
56 56
57 (defvar packages-package-list nil 57 (defvar packages-package-list nil
58 "database of loaded packages and version numbers") 58 "Database of loaded packages and version numbers")
59 59
60 (defvar packages-hierarchy-depth 1 60 (defvar packages-hierarchy-depth 1
61 "Depth of package hierarchies.") 61 "Depth of package hierarchies.")
62 62
63 (defvar packages-load-path-depth 1 63 (defvar packages-load-path-depth 1
82 "Packages last in the load path.") 82 "Packages last in the load path.")
83 83
84 (defvar last-package-load-path nil 84 (defvar last-package-load-path nil
85 "Load path for packages last in the load path.") 85 "Load path for packages last in the load path.")
86 86
87 (defvar package-locations 87 (defun packages-compute-package-locations (user-init-directory)
88 (list 88 "Compute locations of the various package directories.
89 (list (paths-construct-path '("~" ".xemacs"))
90 'early #'(lambda () t))
91 (list "site-packages" 'late #'(lambda () t))
92 (list "infodock-packages" 'late #'(lambda () (featurep 'infodock)))
93 (list "mule-packages" 'late #'(lambda () (featurep 'mule)))
94 (list "xemacs-packages" 'late #'(lambda () t))
95 (list "packages" 'late #'(lambda () t)))
96 "Locations of the various package directories.
97 This is a list each of whose elements describes one directory. 89 This is a list each of whose elements describes one directory.
98 A directory description is a three-element list. 90 A directory description is a three-element list.
99 The first element is either an absolute path or a subdirectory 91 The first element is either an absolute path or a subdirectory
100 in the XEmacs hierarchy. 92 in the XEmacs hierarchy.
101 The second component is one of the symbols EARLY, LATE, LAST, 93 The second component is one of the symbols EARLY, LATE, LAST,
102 depending on the load-path segment the hierarchy is supposed to 94 depending on the load-path segment the hierarchy is supposed to
103 show up in. 95 show up in.
104 The third component is a thunk which, if it returns NIL, causes 96 The third component is a thunk which, if it returns NIL, causes
105 the directory to be ignored.") 97 the directory to be ignored."
98 (list
99 (list (paths-construct-path (list user-init-directory "mule-packages"))
100 'early #'(lambda () (featurep 'mule)))
101 (list (paths-construct-path (list user-init-directory "xemacs-packages"))
102 'early #'(lambda () t))
103 (list "site-packages" 'late #'(lambda () t))
104 (list "infodock-packages" 'late #'(lambda () (featurep 'infodock)))
105 (list "mule-packages" 'late #'(lambda () (featurep 'mule)))
106 (list "xemacs-packages" 'late #'(lambda () t))))
106 107
107 (defun package-get-key-1 (info key) 108 (defun package-get-key-1 (info key)
108 "Locate keyword `key' in list." 109 "Locate keyword `key' in list."
109 (cond ((null info) 110 (cond ((null info)
110 nil) 111 nil)
120 121
121 (defun package-provide (name &rest attributes) 122 (defun package-provide (name &rest attributes)
122 (let ((info (if (and attributes (floatp (car attributes))) 123 (let ((info (if (and attributes (floatp (car attributes)))
123 (list :version (car attributes)) 124 (list :version (car attributes))
124 attributes))) 125 attributes)))
125 (remassq name packages-package-list)
126 (setq packages-package-list 126 (setq packages-package-list
127 (cons (cons name info) packages-package-list)))) 127 (cons (cons name info) (remassq name packages-package-list)))))
128 128
129 (defun package-require (name version) 129 (defun package-require (name version)
130 (let ((pkg (assq name packages-package-list))) 130 (let ((pkg (assq name packages-package-list)))
131 (cond ((null pkg) 131 (cond ((null pkg)
132 (error "Package %s has not been loaded into this XEmacsen" 132 (error "Package %s has not been loaded into this XEmacsen"
171 (defvar packages-unbytecompiled-lisp 171 (defvar packages-unbytecompiled-lisp
172 '("paths.el" 172 '("paths.el"
173 "dumped-lisp.el" 173 "dumped-lisp.el"
174 "dumped-pkg-lisp.el" 174 "dumped-pkg-lisp.el"
175 "version.el" 175 "version.el"
176 "very-early-lisp.el" 176 "very-early-lisp.el")
177 "Installation.el")
178 "Lisp packages that should not be byte compiled.") 177 "Lisp packages that should not be byte compiled.")
179 178
180 179
181 ;; Copied from help.el, could possibly move it to here permanently. 180 ;; Copied from help.el, could possibly move it to here permanently.
182 ;; Unlike the FSF version, our `locate-library' uses the `locate-file' 181 ;; Unlike the FSF version, our `locate-library' uses the `locate-file'
201 (cond ((or (rassq 'jka-compr-handler file-name-handler-alist) 200 (cond ((or (rassq 'jka-compr-handler file-name-handler-alist)
202 (and (boundp 'find-file-hooks) 201 (and (boundp 'find-file-hooks)
203 (member 'crypt-find-file-hook find-file-hooks))) 202 (member 'crypt-find-file-hook find-file-hooks)))
204 ;; Compression involved. 203 ;; Compression involved.
205 (if nosuffix 204 (if nosuffix
206 ":.gz:.Z" 205 '("" ".gz" ".Z")
207 ".elc:.elc.gz:elc.Z:.el:.el.gz:.el.Z::.gz:.Z")) 206 '(".elc" ".elc.gz" "elc.Z" ".el" ".el.gz" ".el.Z" "" ".gz" ".Z")))
208 (t 207 (t
209 ;; No compression. 208 ;; No compression.
210 (if nosuffix 209 (if nosuffix
211 "" 210 ""
212 ".elc:.el:"))) 211 '(".elc" ".el" "")))))))
213 4)))
214 (and interactive-call 212 (and interactive-call
215 (if result 213 (if result
216 (message "Library is file %s" result) 214 (message "Library is file %s" result)
217 (message "No library %s in search path" library))) 215 (message "No library %s in search path" library)))
218 result)) 216 result))
341 339
342 (defun locate-data-file (name &optional dir-list) 340 (defun locate-data-file (name &optional dir-list)
343 "Locate a file in a search path DIR-LIST (a list of directories). 341 "Locate a file in a search path DIR-LIST (a list of directories).
344 If no DIR-LIST is supplied, it defaults to `data-directory-list'. 342 If no DIR-LIST is supplied, it defaults to `data-directory-list'.
345 This function is basically a wrapper over `locate-file'." 343 This function is basically a wrapper over `locate-file'."
346 (unless dir-list 344 (locate-file name (or dir-list data-directory-list)))
347 (setq dir-list data-directory-list))
348 (locate-file name dir-list))
349 345
350 ;; Path setup 346 ;; Path setup
351 347
352 (defun packages-find-package-directories (roots base) 348 (defun packages-find-package-directories (roots base)
353 "Find a set of package directories." 349 "Find a set of package directories."
431 (nconc packages 427 (nconc packages
432 (packages-find-packages-by-name roots name)))))) 428 (packages-find-packages-by-name roots name))))))
433 (setq package-locations (cdr package-locations))) 429 (setq package-locations (cdr package-locations)))
434 packages))) 430 packages)))
435 431
436 (defun packages-find-packages (roots) 432 (defun packages-find-packages (roots package-locations)
437 "Find the packages." 433 "Find the packages."
438 (let ((envvar-value (getenv "EMACSPACKAGEPATH"))) 434 (let ((envvar-value (getenv "EMACSPACKAGEPATH")))
439 (if envvar-value 435 (if envvar-value
440 (packages-split-package-path (paths-decode-directory-path envvar-value)) 436 (packages-split-package-path (paths-decode-directory-path envvar-value))
441 (packages-deconstruct 437 (packages-deconstruct
454 "Construct a path into a component of the packages hierarchy. 450 "Construct a path into a component of the packages hierarchy.
455 PACKAGES is a list of package directories. 451 PACKAGES is a list of package directories.
456 SUFFIXES is a list of names of package subdirectories to look for." 452 SUFFIXES is a list of names of package subdirectories to look for."
457 (let ((directories 453 (let ((directories
458 (apply 454 (apply
459 #'append 455 #'nconc
460 (mapcar #'(lambda (package) 456 (mapcar #'(lambda (package)
461 (mapcar #'(lambda (suffix) 457 (mapcar #'(lambda (suffix)
462 (file-name-as-directory (concat package suffix))) 458 (file-name-as-directory (concat package suffix)))
463 suffixes)) 459 suffixes))
464 packages)))) 460 packages))))
496 ;; Loading package initialization files 492 ;; Loading package initialization files
497 493
498 (defun packages-load-package-lisps (package-load-path base) 494 (defun packages-load-package-lisps (package-load-path base)
499 "Load all Lisp files of a certain name along a load path. 495 "Load all Lisp files of a certain name along a load path.
500 BASE is the base name of the files." 496 BASE is the base name of the files."
501 (mapc #'(lambda (dir) 497 (mapcar #'(lambda (dir)
502 (let ((file-name (expand-file-name base dir))) 498 (let ((file-name (expand-file-name base dir)))
503 (condition-case error 499 (condition-case error
504 (load file-name t t) 500 (load file-name t t)
505 (error 501 (error
506 (warn (format "Autoload error in: %s:\n\t%s" 502 (warn (format "Autoload error in: %s:\n\t%s"
515 (file-name-sans-extension autoload-file-name))) 511 (file-name-sans-extension autoload-file-name)))
516 512
517 (defun packages-handle-package-dumped-lisps (handle package-load-path) 513 (defun packages-handle-package-dumped-lisps (handle package-load-path)
518 "Load dumped-lisp.el files along a load path. 514 "Load dumped-lisp.el files along a load path.
519 Call HANDLE on each file off definitions of PACKAGE-LISP there." 515 Call HANDLE on each file off definitions of PACKAGE-LISP there."
520 (mapc #'(lambda (dir) 516 (mapcar #'(lambda (dir)
521 (let ((file-name (expand-file-name "dumped-lisp.el" dir))) 517 (let ((file-name (expand-file-name "dumped-lisp.el" dir)))
522 (if (file-exists-p file-name) 518 (if (file-exists-p file-name)
523 (let (package-lisp 519 (let (package-lisp
524 ;; 20.4 packages could set this 520 ;; 20.4 packages could set this
525 preloaded-file-list) 521 preloaded-file-list)
526 (load file-name) 522 (load file-name)
527 ;; dumped-lisp.el could have set this ... 523 ;; dumped-lisp.el could have set this ...
528 (if package-lisp 524 (if package-lisp
529 (mapc #'(lambda (base) 525 (mapcar #'(lambda (base)
530 (funcall handle base)) 526 (funcall handle base))
531 package-lisp)))))) 527 package-lisp))))))
532 package-load-path)) 528 package-load-path))
533 529
534 (defun packages-load-package-dumped-lisps (package-load-path) 530 (defun packages-load-package-dumped-lisps (package-load-path)