X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=lisp%2Fpackage-admin.el;h=925f6de7bfc9a06be2c2492443c83483ca571d1c;hp=730f5f34a37c172a6233374c9c360f0ddfc25a2a;hb=5378ab6d2bb24fd8d39025be1574d406cf91f141;hpb=35adcaaeafb1fe93eaf00c39b48619e8f188ff3f diff --git a/lisp/package-admin.el b/lisp/package-admin.el index 730f5f3..925f6de 100644 --- a/lisp/package-admin.el +++ b/lisp/package-admin.el @@ -2,7 +2,7 @@ ;; Copyright (C) 1997 by Free Software Foundation, Inc. -;; Author: SL Baur +;; Author: SL Baur ;; Keywords: internal ;; This file is part of XEmacs. @@ -38,11 +38,13 @@ (defvar package-admin-temp-buffer "*Package Output*" "Temporary buffer where output of backend commands is saved.") -(defvar package-admin-install-function 'package-admin-default-install-function +(defvar package-admin-install-function (if (eq system-type 'windows-nt) + 'package-admin-install-function-mswindows + 'package-admin-default-install-function) "The function to call to install a package. -Three args are passed: FILENAME PKG-DIR BUF +Three args are passed: FILENAME PKG-DIR BUFFER Install package FILENAME into directory PKG-DIR, with any messages output -to buffer BUF.") +to buffer BUFFER.") (defvar package-admin-error-messages '( "No space left on device" @@ -102,6 +104,16 @@ is already implicit, as `looking-at' is used. Filenames can, unfortunately, contain spaces, so be careful in constructing any regexps.") +(defvar package-install-hook nil + "*List of hook functions to be called when a new package is successfully +installed. The hook function is passed two arguments: the package name, and +the install directory.") + +(defvar package-delete-hook nil + "*List of hook functions to be called when a package is deleted. The +hook is called *before* the package is deleted. The hook function is passed +two arguments: the package name, and the install directory.") + ;;;###autoload (defun package-admin-add-single-file-package (file destdir &optional pkg-dir) "Install a single file Lisp package into XEmacs package hierarchy. @@ -121,31 +133,31 @@ The optional `pkg-dir' can be used to override the default package hierarchy ;; rest of command line follows package-admin-xemacs file destination))) -(defun package-admin-install-function-mswindows (file pkg-dir buf) - "Install function for mswindows" +(defun package-admin-install-function-mswindows (file pkg-dir buffer) + "Install function for mswindows." (let ((default-directory (file-name-as-directory pkg-dir))) (unless (file-directory-p default-directory) (make-directory default-directory t)) - (call-process "djtar" nil buf t "-x" file))) + (call-process "minitar" nil buffer t file))) -(defun package-admin-default-install-function (file pkg-dir buf) +(defun package-admin-default-install-function (filename pkg-dir buffer) "Default function to install a package. Install package FILENAME into directory PKG-DIR, with any messages output -to buffer BUF." +to BUFFER." (let* ((pkg-dir (file-name-as-directory pkg-dir)) (default-directory pkg-dir) - (filename (expand-file-name file))) + (filename (expand-file-name filename))) (unless (file-directory-p pkg-dir) (make-directory pkg-dir t)) ;; Don't assume GNU tar. - (if (shell-command (concat "gunzip -c " filename " | tar xvf -") buf) + (if (shell-command (concat "gunzip -c " filename " | tar xvf -") buffer) 0 1) )) ; (call-process "add-big-package.sh" ; nil -; buf +; buffer ; t ; ;; rest of command line follows ; package-admin-xemacs file pkg-dir)) @@ -163,20 +175,22 @@ or return a location appropriate for the package otherwise." (featurep package-feature) (setq autoload-dir (feature-file package-feature)) (setq autoload-dir (file-name-directory autoload-dir)) - (member autoload-dir late-package-load-path)) - ;; Find the corresonding entry in late-package + (member autoload-dir (append early-package-load-path late-package-load-path))) + ;; Find the corresponding entry in late-package (setq pkg-dir (car-safe (member-if (lambda (h) (string-match (concat "^" (regexp-quote h)) autoload-dir)) - late-packages)))) + (append (cdr early-packages) late-packages))))) (if pkg-dir pkg-dir ;; Ok we need to guess (if mule-related (package-admin-get-install-dir 'mule-base nil nil) - (car (last late-packages))))))) - + (if (eq package 'xemacs-base) + (car (last late-packages)) + (package-admin-get-install-dir 'xemacs-base nil nil))))))) + (defun package-admin-get-manifest-file (pkg-topdir package) @@ -290,7 +304,7 @@ is the top-level directory under which the package was installed." ;; Create pkginfo, if necessary (if (not (file-directory-p pathname)) (make-directory pathname)) - (setq pathname (expand-file-name + (setq pathname (expand-file-name (concat "MANIFEST." package-name) pathname)) (save-excursion @@ -324,7 +338,7 @@ is the top-level directory under which the package was installed." start err-list ) (setq pkg-dir (package-admin-get-install-dir 'unknown pkg-dir)) - ;; Insure that the current directory doesn't change + ;; Ensure that the current directory doesn't change (save-excursion (set-buffer buf) ;; This is not really needed @@ -398,6 +412,7 @@ PACKAGE is a symbol, not a string." (let ( (tmpbuf " *pkg-manifest*") manifest-file package-lispdir dirs file) (setq pkg-topdir (package-admin-get-install-dir package pkg-topdir)) (setq manifest-file (package-admin-get-manifest-file pkg-topdir package)) + (run-hook-with-args 'package-delete-hook package pkg-topdir) (if (file-exists-p manifest-file) (progn ;; The manifest file exists! Use it to delete the old distribution. @@ -424,20 +439,20 @@ PACKAGE is a symbol, not a string." ;; Make sure that the file is writable. ;; (This is important under MS Windows.) ;; I do not know why it important under MS Windows but - ;; 1. It bombs out out when the file does not exist. This can be condition-cased + ;; 1. It bombs out when the file does not exist. This can be condition-cased ;; 2. If I removed the write permissions, I do not want XEmacs to just ignore them. ;; If it wants to, XEmacs may ask, but that is about all ;; (set-file-modes file 438) ;; 438 -> #o666 ;; Note, user might have removed the file! (condition-case () (delete-file file) - (error nil))) ;; We may want to turn the error into a Warning? + (error nil))) ;; We may want to turn the error into a Warning? (forward-line 1)) - + ;; Delete empty directories. (if dirs (let ( (orig-default-directory default-directory) -; directory files file + ;; directory files file ) ;; Make sure we preserve the existing `default-directory'. ;; JV, why does this change the default directory? Does it indeed? @@ -469,7 +484,7 @@ PACKAGE is a symbol, not a string." (lambda (dir) (condition-case () (delete-directory dir))) - dirs)) + dirs)) (setq default-directory orig-default-directory) ))) ) @@ -495,7 +510,7 @@ PACKAGE is a symbol, not a string." (package-admin-rmtree package-lispdir) (message "Removing old lisp directory \"%s\" ... done" package-lispdir) - )) + )) ;; Delete the package from the database of installed packages. (package-delete-name package)))