Rename `chinese-cns11643-6' to `=cns11643-6'.
[chise/xemacs-chise.git.1] / lisp / package-admin.el
index 2c99440..925f6de 100644 (file)
@@ -2,7 +2,7 @@
 
 ;; Copyright (C) 1997 by Free Software Foundation, Inc.
 
-;; Author: SL Baur <steve@altair.xemacs.org>
+;; Author: SL Baur <steve@xemacs.org>
 ;; Keywords: internal
 
 ;; This file is part of XEmacs.
@@ -42,9 +42,9 @@
                                           '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"
@@ -104,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.
@@ -123,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 "minitar" nil buf t 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))
@@ -165,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)
@@ -292,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
@@ -400,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.
@@ -426,20 +439,21 @@ 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?
                  (unwind-protect
@@ -470,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)
                    )))
            )
@@ -496,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)))