Mercurial > hg > xemacs-beta

comparison lisp/packages.el @ 412:697ef44129c6 r21-2-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-14
author cvs
date Mon, 13 Aug 2007 11:20:41 +0200
parents de805c49cfc1
children 41dbb7a9d5f2
comparison
equal deleted inserted replaced
411:12e008d41344 412:697ef44129c6
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@xemacs.org> 5 ;; Author: Steven L Baur <steve@altair.xemacs.org>
6 ;; Maintainer: Steven L Baur <steve@xemacs.org> 6 ;; Maintainer: Steven L Baur <steve@altair.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
36 36
37 ;; - not to use the `lambda' macro. Use #'(lambda ...) instead. 37 ;; - not to use the `lambda' macro. Use #'(lambda ...) instead.
38 ;; (this goes for any package loaded before `subr.el'.) 38 ;; (this goes for any package loaded before `subr.el'.)
39 ;; 39 ;;
40 ;; - not to use macros, because they are not yet available (and this 40 ;; - not to use macros, because they are not yet available (and this
41 ;; file must be loadable uncompiled.) Built in macros, such as 41 ;; file must be loadable uncompiled.) This rules out CL-style
42 ;; `when' and `unless' are fine, of course. 42 ;; macros like `when', for instance.
43 ;; 43 ;;
44 ;; - not to use `defcustom'. If you must add user-customizable 44 ;; - not to use `defcustom'. If you must add user-customizable
45 ;; variables here, use `defvar', and add the variable to 45 ;; variables here, use `defvar', and add the variable to
46 ;; `cus-start.el'. 46 ;; `cus-start.el'.
47 47
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 (defun packages-compute-package-locations (user-init-directory) 87 (defvar package-locations
88 "Compute locations of the various package directories. 88 (list
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.
89 This is a list each of whose elements describes one directory. 97 This is a list each of whose elements describes one directory.
90 A directory description is a three-element list. 98 A directory description is a three-element list.
91 The first element is either an absolute path or a subdirectory 99 The first element is either an absolute path or a subdirectory
92 in the XEmacs hierarchy. 100 in the XEmacs hierarchy.
93 The second component is one of the symbols EARLY, LATE, LAST, 101 The second component is one of the symbols EARLY, LATE, LAST,
94 depending on the load-path segment the hierarchy is supposed to 102 depending on the load-path segment the hierarchy is supposed to
95 show up in. 103 show up in.
96 The third component is a thunk which, if it returns NIL, causes 104 The third component is a thunk which, if it returns NIL, causes
97 the directory to be ignored." 105 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))))
107 106
108 (defun package-get-key-1 (info key) 107 (defun package-get-key-1 (info key)
109 "Locate keyword `key' in list." 108 "Locate keyword `key' in list."
110 (cond ((null info) 109 (cond ((null info)
111 nil) 110 nil)
121 120
122 (defun package-provide (name &rest attributes) 121 (defun package-provide (name &rest attributes)
123 (let ((info (if (and attributes (floatp (car attributes))) 122 (let ((info (if (and attributes (floatp (car attributes)))
124 (list :version (car attributes)) 123 (list :version (car attributes))
125 attributes))) 124 attributes)))
125 (remassq name packages-package-list)
126 (setq packages-package-list 126 (setq packages-package-list
127 (cons (cons name info) (remassq name packages-package-list))))) 127 (cons (cons name info) 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"
348 (defun packages-find-package-directories (roots base) 348 (defun packages-find-package-directories (roots base)
349 "Find a set of package directories." 349 "Find a set of package directories."
350 ;; make sure paths-find-version-directory and paths-find-site-directory 350 ;; make sure paths-find-version-directory and paths-find-site-directory
351 ;; don't both pick up version-independent directories ... 351 ;; don't both pick up version-independent directories ...
352 (let ((version-directory (paths-find-version-directory roots base nil nil t)) 352 (let ((version-directory (paths-find-version-directory roots base nil nil t))
353 (site-directory (paths-find-site-directory roots base nil nil t))) 353 (site-directory (paths-find-site-directory roots base)))
354 (paths-uniq-append 354 (paths-uniq-append
355 (and version-directory (list version-directory)) 355 (and version-directory (list version-directory))
356 (and site-directory (list site-directory))))) 356 (and site-directory (list site-directory)))))
357 357
358 (defvar packages-special-base-regexp "^\\(etc\\|info\\|lisp\\|lib-src\\|bin\\|pkginfo\\)$" 358 (defvar packages-special-base-regexp "^\\(etc\\|info\\|lisp\\|lib-src\\|bin\\|pkginfo\\)$"
427 (nconc packages 427 (nconc packages
428 (packages-find-packages-by-name roots name)))))) 428 (packages-find-packages-by-name roots name))))))
429 (setq package-locations (cdr package-locations))) 429 (setq package-locations (cdr package-locations)))
430 packages))) 430 packages)))
431 431
432 (defun packages-find-packages (roots package-locations) 432 (defun packages-find-packages (roots)
433 "Find the packages." 433 "Find the packages."
434 (let ((envvar-value (getenv "EMACSPACKAGEPATH"))) 434 (let ((envvar-value (getenv "EMACSPACKAGEPATH")))
435 (if envvar-value 435 (if envvar-value
436 (packages-split-package-path (paths-decode-directory-path envvar-value)) 436 (packages-split-package-path (paths-decode-directory-path envvar-value))
437 (packages-deconstruct 437 (packages-deconstruct
450 "Construct a path into a component of the packages hierarchy. 450 "Construct a path into a component of the packages hierarchy.
451 PACKAGES is a list of package directories. 451 PACKAGES is a list of package directories.
452 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."
453 (let ((directories 453 (let ((directories
454 (apply 454 (apply
455 #'nconc 455 #'append
456 (mapcar #'(lambda (package) 456 (mapcar #'(lambda (package)
457 (mapcar #'(lambda (suffix) 457 (mapcar #'(lambda (suffix)
458 (file-name-as-directory (concat package suffix))) 458 (file-name-as-directory (concat package suffix)))
459 suffixes)) 459 suffixes))
460 packages)))) 460 packages))))
492 ;; Loading package initialization files 492 ;; Loading package initialization files
493 493
494 (defun packages-load-package-lisps (package-load-path base) 494 (defun packages-load-package-lisps (package-load-path base)
495 "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.
496 BASE is the base name of the files." 496 BASE is the base name of the files."
497 (mapcar #'(lambda (dir) 497 (mapc #'(lambda (dir)
498 (let ((file-name (expand-file-name base dir))) 498 (let ((file-name (expand-file-name base dir)))
499 (condition-case error 499 (condition-case error
500 (load file-name t t) 500 (load file-name t t)
501 (error 501 (error
502 (warn (format "Autoload error in: %s:\n\t%s" 502 (warn (format "Autoload error in: %s:\n\t%s"
511 (file-name-sans-extension autoload-file-name))) 511 (file-name-sans-extension autoload-file-name)))
512 512
513 (defun packages-handle-package-dumped-lisps (handle package-load-path) 513 (defun packages-handle-package-dumped-lisps (handle package-load-path)
514 "Load dumped-lisp.el files along a load path. 514 "Load dumped-lisp.el files along a load path.
515 Call HANDLE on each file off definitions of PACKAGE-LISP there." 515 Call HANDLE on each file off definitions of PACKAGE-LISP there."
516 (mapcar #'(lambda (dir) 516 (mapc #'(lambda (dir)
517 (let ((file-name (expand-file-name "dumped-lisp.el" dir))) 517 (let ((file-name (expand-file-name "dumped-lisp.el" dir)))
518 (if (file-exists-p file-name) 518 (if (file-exists-p file-name)
519 (let (package-lisp 519 (let (package-lisp
520 ;; 20.4 packages could set this 520 ;; 20.4 packages could set this
521 preloaded-file-list) 521 preloaded-file-list)
522 (load file-name) 522 (load file-name)
523 ;; dumped-lisp.el could have set this ... 523 ;; dumped-lisp.el could have set this ...
524 (if package-lisp 524 (if package-lisp
525 (mapcar #'(lambda (base) 525 (mapc #'(lambda (base)
526 (funcall handle base)) 526 (funcall handle base))
527 package-lisp)))))) 527 package-lisp))))))
528 package-load-path)) 528 package-load-path))
529 529
530 (defun packages-load-package-dumped-lisps (package-load-path) 530 (defun packages-load-package-dumped-lisps (package-load-path)