Mercurial > hg > xemacs-beta

comparison lisp/packages.el @ 267:966663fcf606 r20-5b32

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-5b32
author cvs
date Mon, 13 Aug 2007 10:26:29 +0200
parents 405dd6d1825b
children b2472a1930f2
comparison
equal deleted inserted replaced
266:18d185df8c54 267:966663fcf606
46 ;; `cus-start.el'. 46 ;; `cus-start.el'.
47 47
48 ;; Because of all this, make sure that the stuff you put here really 48 ;; Because of all this, make sure that the stuff you put here really
49 ;; belongs here. 49 ;; belongs here.
50 50
51 ;; This file requires find-paths.el.
51 52
52 ;;; Code: 53 ;;; Code:
53 54
54 ;;; Package versioning 55 ;;; Package versioning
55 56
56 (defvar packages-package-list nil 57 (defvar packages-package-list nil
57 "database of loaded packages and version numbers") 58 "database of loaded packages and version numbers")
59
60 (defvar early-packages nil
61 "Packages early in the load path.")
62
63 (defvar early-package-load-path nil
64 "Load path for packages early in the load path.")
65
66 (defvar early-packages nil
67 "Packages late in the load path.")
68
69 (defvar late-package-load-path nil
70 "Load path for packages late in the load path.")
58 71
59 (defun package-get-key-1 (info key) 72 (defun package-get-key-1 (info key)
60 "Locate keyword `key' in list." 73 "Locate keyword `key' in list."
61 (cond ((null info) 74 (cond ((null info)
62 nil) 75 nil)
247 "Reload new or updated dumped lisp files (with exceptions). 260 "Reload new or updated dumped lisp files (with exceptions).
248 This is an extremely dangerous function to call at any time." 261 This is an extremely dangerous function to call at any time."
249 ;; Nothing for the moment 262 ;; Nothing for the moment
250 nil) 263 nil)
251 264
252 ;; The following function is called from temacs
253 (defun packages-find-packages-1 (package path-only append-p user-package)
254 "Search the supplied directory for associated directories.
255 The top level is assumed to look like:
256 info/ Contain texinfo files for lisp installed in this hierarchy
257 etc/ Contain data files for lisp installled in this hierarchy
258 lisp/ Contain directories which either have straight lisp code
259 or are self-contained packages of their own.
260
261 If the argument `append-p' is non-nil, the found directories will be
262 appended to the paths, otherwise, they will be prepended.
263
264 This is an internal function. Do not call it after startup."
265 ;; Info files
266 (if (and (null path-only) (file-directory-p (concat package "/info")))
267 (let ((dir (concat package "/info/")))
268 (if (not (member dir Info-default-directory-list))
269 (nconc Info-default-directory-list (list dir)))))
270 ;; Data files
271 (if (and (null path-only) (file-directory-p (concat package "/etc")))
272 (setq data-directory-list
273 (if append-p
274 (append data-directory-list (list (concat package "/etc/")))
275 (cons (concat package "/etc/") data-directory-list))))
276 ;; Lisp files
277 (if (file-directory-p (concat package "/lisp"))
278 (progn
279 ; (print (concat "DIR: "
280 ; (if user-package "[USER]" "")
281 ; package
282 ; "/lisp/"))
283 (setq load-path
284 (if append-p
285 (append load-path (list (concat package "/lisp/")))
286 (cons (concat package "/lisp/") load-path)))
287
288 ;; Locate and process a dumped-lisp.el file if it exists
289 (if (and (running-temacs-p)
290 (file-exists-p (concat package "/lisp/dumped-lisp.el")))
291 (let (package-lisp)
292 (let (preloaded-file-list)
293 (load (concat package "/lisp/dumped-lisp.el")))
294 (if package-lisp
295 (progn
296 (if (boundp 'preloaded-file-list)
297 (setq preloaded-file-list
298 (append preloaded-file-list package-lisp)))
299 (if (fboundp 'load-gc)
300 (setq dumped-lisp-packages
301 (append dumped-lisp-packages package-lisp)))))))
302
303 (if user-package
304 (condition-case error
305 (load (concat package "/lisp/"
306 (file-name-sans-extension autoload-file-name))
307 t)
308 (error
309 (warn (format "Autoload error in: %s/lisp/:\n\t%s"
310 package
311 (with-output-to-string
312 (display-error error nil)))))))
313 (let ((dirs (directory-files (concat package "/lisp/")
314 t "^[^-.]" nil 'dirs-only))
315 dir)
316 (while dirs
317 (setq dir (car dirs))
318 ; (print (concat "DIR: " dir "/"))
319 (setq load-path
320 (if append-p
321 (append load-path (list (concat dir "/")))
322 (cons (concat dir "/") load-path)))
323
324 ;; Locate and process a dumped-lisp.el file if it exists
325 (if (and (running-temacs-p)
326 (file-exists-p (concat dir "/dumped-lisp.el")))
327 (let (package-lisp)
328 (let (preloaded-file-list)
329 (load (concat dir "/dumped-lisp.el")))
330 (if package-lisp
331 (progn
332 (if (boundp 'preloaded-file-list)
333 (setq preloaded-file-list
334 (append preloaded-file-list package-lisp)))
335 (if (fboundp 'load-gc)
336 (setq dumped-lisp-packages
337 (append dumped-lisp-packages
338 package-lisp)))))))
339
340 (if user-package
341 (condition-case error
342 (progn
343 ; (print
344 ; (concat dir "/"
345 ; (file-name-sans-extension autoload-file-name)))
346 (load
347 (concat dir "/"
348 (file-name-sans-extension autoload-file-name))
349 t))
350 (error
351 (warn (format "Autoload error in: %s/:\n\t%s"
352 dir
353 (with-output-to-string
354 (display-error error nil)))))))
355 (packages-find-packages-1 dir path-only append-p user-package)
356 (setq dirs (cdr dirs)))))))
357
358 ;; The following function is called from temacs
359 (defun packages-find-packages-2 (path path-only append-p suppress-user)
360 "Search the supplied path for associated directories.
361 If the argument `append-p' is non-nil, the found directories will be
362 appended to the paths, otherwise, they will be prepended.
363
364 This is an internal function. Do not call it after startup."
365 (let (dir)
366 (while path
367 (setq dir (car path))
368 ;; (prin1 (concat "Find: " (expand-file-name dir) "\n"))
369 (if (null (and (or suppress-user inhibit-package-init)
370 (string-match "^~" dir)))
371 (progn
372 ;; (print dir)
373 (packages-find-packages-1 (expand-file-name dir)
374 path-only
375 append-p
376 (string-match "^~" dir))))
377 (setq path (cdr path)))))
378
379 ;; The following function is called from temacs
380 (defun packages-find-packages (pkg-path path-only &optional suppress-user)
381 "Search the supplied path for additional info/etc/lisp directories.
382 Lisp directories if configured prior to build time will have equivalent
383 status as bundled packages.
384 If the argument `path-only' is non-nil, only the `load-path' will be set,
385 otherwise data directories and info directories will be added.
386 If the optional argument `suppress-user' is non-nil, package directories
387 rooted in a user login directory (like ~/.xemacs) will not be searched.
388 This is used at dump time to suppress the builder's local environment."
389 (let ((prefix-path nil))
390 (while (and pkg-path (car pkg-path))
391 (setq prefix-path (cons (car pkg-path) prefix-path)
392 pkg-path (cdr pkg-path)))
393 (packages-find-packages-2 (cdr pkg-path) path-only t suppress-user)
394 (packages-find-packages-2 prefix-path path-only nil suppress-user)))
395
396
397 ;; Data-directory is really a list now. Provide something to search it for 265 ;; Data-directory is really a list now. Provide something to search it for
398 ;; directories. 266 ;; directories.
399 267
400 (defun locate-data-directory (name &optional dir-list) 268 (defun locate-data-directory (name &optional dir-list)
401 "Locate a directory in a search path DIR-LIST (a list of directories). 269 "Locate a directory in a search path DIR-LIST (a list of directories).
420 This function is basically a wrapper over `locate-file'." 288 This function is basically a wrapper over `locate-file'."
421 (unless dir-list 289 (unless dir-list
422 (setq dir-list data-directory-list)) 290 (setq dir-list data-directory-list))
423 (locate-file name dir-list)) 291 (locate-file name dir-list))
424 292
425 ;; If we are being loaded as part of being dumped, bootstrap the rest of the 293 ;; Path setup
426 ;; load-path for loaddefs. 294
427 (if (fboundp 'load-gc) 295 (defun packages-find-package-path (roots)
428 (packages-find-packages package-path t t)) 296 "Construct the package path underneath installation roots ROOTS."
297 (let ((envvar-value (getenv "EMACSPACKAGEPATH")))
298 (if envvar-value
299 (decode-path-internal envvar-value)
300 (let ((site-base-directory (paths-find-site-directory roots "packages"))
301 (version-base-directory (paths-find-version-directory roots "packages")))
302 (if (or site-base-directory version-base-directory)
303 (let ((site-mule-directory
304 (and (featurep 'mule)
305 (paths-find-site-directory roots
306 "mule-packages")))
307 (version-mule-directory
308 (and (featurep 'mule)
309 (paths-find-version-directory roots
310 "mule-packages"))))
311 (append '("~/.xemacs/")
312 '(nil)
313 (and version-mule-directory
314 (null (string-equal version-mule-directory
315 site-mule-directory))
316 (list version-mule-directory))
317 (and site-mule-directory
318 (list site-mule-directory))
319 (and version-base-directory
320 (null (string-equal version-base-directory
321 site-base-directory))
322 (list version-base-directory))
323 (and site-base-directory
324 (list site-base-directory))))
325 configure-package-path)))))
326
327 (defvar packages-special-bases '("etc" "info" "lisp" "lib-src" "bin")
328 "Special subdirectories of packages.")
329
330 (defun packages-find-packages-in-directories (directories)
331 "Find all packages underneath directories in DIRECTORIES."
332 (paths-find-recursive-path directories
333 (append paths-version-control-bases
334 packages-special-bases)))
335
336 (defun packages-split-path (path)
337 "Split PATH at NIL, return pair with two components.
338 The second component is shared with PATH."
339 (let ((reverse-early '()))
340 (while (and path (null (null (car path))))
341 (setq reverse-early (cons (car path) reverse-early))
342 (setq path (cdr path)))
343 (if (null path)
344 (cons nil path)
345 (cons (reverse reverse-early) (cdr path)))))
346
347 (defun packages-find-packages (package-path &optional inhibit)
348 "Search for all packages in PACKAGE-PATH.
349 PACKAGE-PATH may distinguish (by NIL-separation) between early
350 and late packages.
351 If INHIBIT is non-NIL, return empty paths.
352 This returns (CONS EARLY-PACKAGES LATE-PACKAGES)."
353 (if inhibit
354 (cons '() '())
355 (let* ((stuff (packages-split-path package-path))
356 (early (car stuff))
357 (late (cdr stuff)))
358 (cons (packages-find-packages-in-directories early)
359 (packages-find-packages-in-directories late)))))
360
361 (defun packages-find-package-library-path (packages suffixes)
362 "Construct a path into a component of the packages hierarchy.
363 PACKAGES is a list of package directories.
364 SUFFIXES is a list of names of package subdirectories to look for."
365 (let ((directories
366 (apply
367 #'append
368 (mapcar #'(lambda (package)
369 (mapcar #'(lambda (suffix)
370 (concat package suffix))
371 suffixes))
372 packages))))
373 (paths-directories-which-exist directories)))
374
375 (defun packages-find-package-load-path (packages)
376 "Construct the load-path component for packages.
377 PACKAGES is a list of package directories."
378 (paths-find-recursive-load-path
379 (packages-find-package-library-path packages '("lisp/"))))
380
381 (defun packages-find-package-exec-path (packages)
382 (packages-find-package-library-path packages
383 (list (concat "bin/" system-configuration "/")
384 "lib-src/")))
385
386 (defun packages-find-package-info-path (packages)
387 (packages-find-package-library-path packages '("info/")))
388
389 (defun packages-find-package-data-path (packages)
390 (packages-find-package-library-path packages '("etc/")))
391
392 ;; Loading package initialization files
393
394 (defun packages-load-package-lisps (package-load-path base)
395 "Load all Lisp files of a certain name along a load path.
396 BASE is the base name of the files."
397 (mapc #'(lambda (dir)
398 (let ((file-name (expand-file-name base dir)))
399 (if (file-exists-p file-name)
400 (condition-case error
401 (load file-name)
402 (error
403 (warn (format "Autoload error in: %s:\n\t%s"
404 file-name
405 (with-output-to-string
406 (display-error error nil)))))))))
407 package-load-path))
408
409 (defun packages-load-package-auto-autoloads (package-load-path)
410 "Load auto-autoload files along a load path."
411 (packages-load-package-lisps package-load-path
412 (file-name-sans-extension autoload-file-name)))
413
414 (defun packages-handle-package-dumped-lisps (handle package-load-path)
415 "Load dumped-lisp.el files along a load path.
416 Call HANDLE on each file off definitions of PACKAGE-LISP there."
417 (mapc #'(lambda (dir)
418 (let ((file-name (expand-file-name "dumped-lisp.el" dir)))
419 (if (file-exists-p file-name)
420 (let (package-lisp
421 ;; 20.4 packages could set this
422 preloaded-file-list)
423 (load file-name)
424 ;; dumped-lisp.el could have set this ...
425 (if package-lisp
426 (mapc #'(lambda (base)
427 (funcall handle (expand-file-name base dir)))
428 package-lisp))))))
429 package-load-path))
430
431 (defun packages-load-package-dumped-lisps (package-load-path)
432 "Load dumped-lisp.el files along a load path.
433 Also load files off PACKAGE-LISP definitions there"
434 (packages-handle-package-dumped-lisps #'load package-load-path))
435
436 (defun packages-collect-package-dumped-lisps (package-load-path)
437 "Load dumped-lisp.el files along a load path.
438 Return list of files off PACKAGE-LISP definitions there"
439 (let ((*files* '()))
440 (packages-handle-package-dumped-lisps
441 #'(lambda (file)
442 (setq *files* (cons (file-name-nondirectory file)
443 *files*)))
444 package-load-path)
445 (reverse *files*)))
429 446
430 (provide 'packages) 447 (provide 'packages)
431 448
432 ;;; packages.el ends here 449 ;;; packages.el ends here