xemacs-beta: lisp/packages.el comparison

comparison lisp/packages.el @ 235:85a06df23a9a r20-5b16

Import from CVS: tag r20-5b16

author	cvs
date	Mon, 13 Aug 2007 10:14:40 +0200
parents	52952cbfc5b5
children	89ec2bb86eea

comparison

equal deleted inserted replaced

-:946e7f6ce379
+:85a06df23a9a
 ;;; packages.el --- Low level support for XEmacs packages
 ;; Copyright (C) 1997 Free Software Foundation, Inc.
 ;; Author: Steven L Baur <steve@altair.xemacs.org>
+;; Maintainer: Steven L Baur <steve@altair.xemacs.org>
 ;; Keywords: internal, lisp, dumped
 ;; This file is part of XEmacs.
 ;; XEmacs is free software; you can redistribute it and/or modify it
 ;;; Package versioning
 (defvar packages-package-list nil
 "database of loaded packages and version numbers")
-(defun package-provide (name version)
+(defun package-get-key-1 (info key)
-(if (not (assq name packages-package-list))
+"Locate keyword `key' in list."
-(setq packages-package-list
+(cond ((null info)
-	    (cons (cons name version) packages-package-list))))
+	 nil)
+	((eq (car info) key)
+	 (nth 1 info))
+	(t (package-get-key-1 (cddr info) key))))
+(defun package-get-key (name key)
+"Get info `key' from package `name'."
+(let ((info (assq name packages-package-list)))
+(when info
+(package-get-key-1 (cdr info) key))))
+(defun package-provide (name &rest attributes)
+(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))))
 (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"
 (defun packages-add-suffix (str)
 (if (null (string-match "\\.el\\'" str))
 (concat str ".elc")
 str))
-(defun list-autoloads-path ()
+(defun packages-list-autoloads-path ()
 "List autoloads from precomputed load-path."
 (let ((path load-path)
 	autoloads)
 (while path
 (if (file-exists-p (concat (car path)
 					autoload-file-name)
 				autoloads)))
 (setq path (cdr path)))
 autoloads))
-(defun list-autoloads ()
+(defun packages-list-autoloads ()
 "List autoload files in (what will be) the normal lisp search path.
 This function is used during build to find where the global symbol files so
 they can be perused for their useful information."
 ;; Source directory may not be initialized yet.
 ;; (print (prin1-to-string load-path))
 (if (null source-directory)
 (setq source-directory (concat (car load-path) "./")))
-(let ((files (directory-files (file-name-as-directory source-directory) t ".*"))
+(let ((files (directory-files (file-name-as-directory source-directory)
+				t ".*"))
 	file autolist)
 ;; (print (prin1-to-string source-directory))
 ;; (print (prin1-to-string files))
 (while (setq file (car-safe files))
 (if (and (file-directory-p file)
 	       (file-exists-p (concat file "/" autoload-file-name)))
 	  (setq autolist (cons (concat file "/" autoload-file-name)
 			       autolist)))
 (setq files (cdr files)))
 autolist))
+;; The following function cannot be called from a bare temacs
+(defun packages-new-autoloads ()
+"Return autoloads files that have been added or modified since XEmacs dump."
+(require 'loadhist)
+(let ((me (concat invocation-directory invocation-name))
+	(path load-path)
+	result dir)
+(while path
+(setq dir (file-truename (car path)))
+(let ((autoload-file (file-name-sans-extension (concat
+						      dir
+						      autoload-file-name))))
+	;; Check for:
+	;; 1.  An auto-autoload file that hasn't provided a feature (because
+	;;     it has been installed since XEmacs was dumped).
+	;; 2.  auto-autoload.el being newer than the executable
+	;; 3.  auto-autoload.elc being newer than the executable (the .el
+	;;     could be missing or compressed)
+	(when (or (and (null (file-provides autoload-file))
+		       (or (file-exists-p (concat autoload-file ".elc"))
+			   (file-exists-p (concat autoload-file ".el"))))
+		  (and (file-newer-than-file-p (concat autoload-file ".el") me)
+		       (setq autoload-file (concat autoload-file ".el")))
+		  (and (file-newer-than-file-p (concat autoload-file
+						       ".elc")
+					       me)
+		       (setq autoload-file (concat autoload-file ".elc"))))
+	  (push autoload-file result)))
+(setq path (cdr path)))
+result))
+;; The following function cannot be called from a bare temacs
+(defun packages-reload-autoloads ()
+"Reload new or updated auto-autoloads files.
+This is an extremely dangerous function to call after the user-init-files
+is run.  Don't call it or you'll be sorry."
+(let ((autoload-list (packages-new-autoloads)))
+(while autoload-list
+(let* ((autoload-file (car autoload-list))
+	     (feature (car-safe (file-provides autoload-file))))
+	(when feature
+	  ;; (message "(unload-feature %S)" feature)
+	  (unload-feature feature))
+	(load autoload-file))
+(setq autoload-list (cdr autoload-list)))))
+;; The following function cannot be called from a bare temacs
+(defun packages-reload-dumped-lisp ()
+"Reload new or updated dumped lisp files (with exceptions).
+This is an extremely dangerous function to call at any time."
+;; Nothing for the moment
+nil)
 ;; The following function is called from temacs
 (defun packages-find-packages-1 (package path-only append-p user-package)
 "Search the supplied directory for associated directories.
 The top level is assumed to look like:
 			(if (boundp 'preloaded-file-list)
 			    (setq preloaded-file-list
 				  (append preloaded-file-list package-lisp)))
 			(if (fboundp 'load-gc)
 			    (setq dumped-lisp-packages
-				  (append dumped-lisp-packages package-lisp)))))))
+				  (append dumped-lisp-packages
+					  package-lisp)))))))
 	    (if user-package
 		(condition-case error
 		    (progn
 ;		      (print

Mercurial > hg > xemacs-beta

comparison lisp/packages.el @ 235:85a06df23a9a r20-5b16