X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=lisp%2Fpackage-admin.el;h=333d303a728bc32c3158a21224cca99cf05ee965;hp=e205846a13e8cddecaf97635abc6f2739efc6fbe;hb=59eec5f21669e81977b5b1fe9bf717cab49cf7fb;hpb=b267e52aa03bee2c488c8a78824d96cf2d9a6ccc diff --git a/lisp/package-admin.el b/lisp/package-admin.el index e205846..333d303 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,7 +38,9 @@ (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 Install package FILENAME into directory PKG-DIR, with any messages output @@ -123,16 +125,20 @@ The optional `pkg-dir' can be used to override the default package hierarchy (defun package-admin-install-function-mswindows (file pkg-dir buf) "Install function for mswindows" - (let ( (default-directory pkg-dir) ) - (call-process "djtar" nil buf t "-x" file) - )) + (let ((default-directory (file-name-as-directory pkg-dir))) + (unless (file-directory-p default-directory) + (make-directory default-directory t)) + (call-process "minitar" nil buf t file))) (defun package-admin-default-install-function (file pkg-dir buf) "Default function to install a package. Install package FILENAME into directory PKG-DIR, with any messages output to buffer BUF." - (let (filename) - (setq filename (expand-file-name file pkg-dir)) + (let* ((pkg-dir (file-name-as-directory pkg-dir)) + (default-directory pkg-dir) + (filename (expand-file-name file))) + (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) 0 @@ -160,7 +166,7 @@ or return a location appropriate for the package otherwise." (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 + ;; Find the corresponding entry in late-package (setq pkg-dir (car-safe (member-if (lambda (h) (string-match (concat "^" (regexp-quote h)) @@ -171,7 +177,9 @@ or return a location appropriate for the package otherwise." ;; 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))))))) @@ -320,10 +328,11 @@ 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) - (setq default-directory pkg-dir) + ;; This is not really needed + (setq default-directory (file-name-as-directory pkg-dir)) (setq case-fold-search t) (buffer-disable-undo) (goto-char (setq start (point-max))) @@ -432,7 +441,8 @@ PACKAGE is a symbol, not a string." ;; 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? (unwind-protect