git.chise.org Git - chise/xemacs-chise.git.1/blob - lisp/package-admin.el

   1 ;;; package-admin.el --- Installation and Maintenance of XEmacs packages
   2
   3 ;; Copyright (C) 1997 by Free Software Foundation, Inc.
   4 ;; Copyright (C) 2003, Steve Youngs.
   5
   6 ;; Author: SL Baur <steve@xemacs.org>
   7 ;; Keywords: internal
   8
   9 ;; This file is part of XEmacs.
  10
  11 ;; XEmacs is free software; you can redistribute it and/or modify it
  12 ;; under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; XEmacs is distributed in the hope that it will be useful, but
  17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 ;; General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  23 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  24 ;; 02111-1307, USA.
  25
  26 ;;; Synched up with: Not in FSF
  27
  28 ;;; Commentary:
  29
  30 ;; First pass at lisp front end to package maintenance.
  31
  32 ;;; Code:
  33
  34 (require 'config)
  35
  36 (defvar package-admin-xemacs (concat invocation-directory invocation-name)
  37   "Location of XEmacs binary to use.")
  38
  39 (defvar package-admin-temp-buffer "*Package Output*"
  40   "Temporary buffer where output of backend commands is saved.")
  41
  42 (defvar package-admin-install-function (if (eq system-type 'windows-nt)
  43                                            'package-admin-install-function-mswindows
  44                                          'package-admin-default-install-function)
  45   "The function to call to install a package.
  46 Three args are passed: FILENAME PKG-DIR BUFFER
  47 Install package FILENAME into directory PKG-DIR, with any messages output
  48 to buffer BUFFER.")
  49
  50 (defvar package-admin-error-messages '(
  51                                        "No space left on device"
  52                                        "No such file or directory"
  53                                        "Filename too long"
  54                                        "Read-only file system"
  55                                        "File too large"
  56                                        "Too many open files"
  57                                        "Not enough space"
  58                                        "Permission denied"
  59                                        "Input/output error"
  60                                        "Out of memory"
  61                                        "Unable to create directory"
  62                                        "Directory checksum error"
  63                                        "Cannot exclusively open file"
  64                                        "corrupted file"
  65                                        "incomplete .* tree"
  66                                        "Bad table"
  67                                        "corrupt input"
  68                                        "invalid compressed data"
  69                                        "too many leaves in Huffman tree"
  70                                        "not a valid zip file"
  71                                        "first entry not deflated or stored"
  72                                        "encrypted file --"
  73                                        "unexpected end of file"
  74                                        )
  75   "Regular expressions of possible error messages.
  76 After each package extraction, the `package-admin-temp-buffer' buffer is
  77 scanned for these messages.  An error code is returned if one of these are
  78 found.
  79
  80 This is awful, but it exists because error return codes aren't reliable
  81 under MS Windows.")
  82
  83 (defvar package-admin-tar-filename-regexps
  84   '(
  85     ;; GNU tar:
  86     ;; drwxrwxr-x john/doe 123 1997-02-18 15:48 pathname
  87     "\\S-+\\s-+[-a-z0-9_/]+\\s-+[0-9]+\\s-+[-0-9]+\\s-+[0-9:]+\\s-+\\(\\S-.*\\)"
  88     ;; HP-UX & SunOS tar:
  89     ;; rwxrwxr-x 501/501    123 Feb 18 15:46 1997 pathname
  90     ;; Solaris tar (phooey!):
  91     ;; rwxrwxr-x501/501    123 Feb 18 15:46 1997 pathname
  92     ;; AIX tar:
  93     ;; -rw-r--r-- 147 1019   32919 Mar 26 12:00:09 1992 pathname
  94     "\\S-+\\s-*[-a-z0-9_]+[/ ][-a-z0-9_]+\\s-+[0-9]+\\s-+[a-z][a-z][a-z]\\s-+[0-9]+\\s-+[0-9:]+\\s-+[0-9]+\\s-+\\(\\S-.*\\)"
  95
  96     ;; djtar:
  97     ;; drwx Aug 31 02:01:41 1998       123 pathname
  98     "\\S-+\\s-+[a-z][a-z][a-z]\\s-+[0-9]+\\s-+[0-9:]+\\s-+[0-9]+\\s-+[0-9]+\\s-+\\(\\S-.*\\)"
  99
 100     )
 101   "List of regexps to use to search for tar filenames.
 102 Note that \"\\(\" and \"\\)\" must be used to delimit the pathname (as
 103 match #1).  Don't put \"^\" to match the beginning of the line; this
 104 is already implicit, as `looking-at' is used.  Filenames can,
 105 unfortunately, contain spaces, so be careful in constructing any
 106 regexps.")
 107
 108 (defvar package-install-hook nil
 109   "*List of hook functions to be called when a new package is successfully
 110 installed. The hook function is passed two arguments: the package name, and
 111 the install directory.")
 112
 113 (defvar package-delete-hook nil
 114   "*List of hook functions to be called when a package is deleted. The
 115 hook is called *before* the package is deleted. The hook function is passed
 116 two arguments: the package name, and the install directory.")
 117
 118 (defun package-admin-install-function-mswindows (file pkg-dir buffer)
 119   "Install function for mswindows."
 120   (let ((default-directory (file-name-as-directory pkg-dir)))
 121     (unless (file-directory-p default-directory)
 122       (make-directory default-directory t))
 123     (call-process "minitar" nil buffer t file)))
 124
 125 (defun package-admin-default-install-function (filename pkg-dir buffer)
 126   "Default function to install a package.
 127 Install package FILENAME into directory PKG-DIR, with any messages output
 128 to BUFFER."
 129   (let* ((pkg-dir (file-name-as-directory pkg-dir))
 130          (default-directory pkg-dir)
 131          (filename (expand-file-name filename)))
 132     (unless (file-directory-p pkg-dir)
 133       (make-directory pkg-dir t))
 134     ;; Don't assume GNU tar.
 135     (if (shell-command (concat "gunzip -c " filename " | tar xvf -") buffer)
 136         0
 137       1)))
 138
 139 ;; A few things needed by the following 2 functions.
 140 (eval-when-compile
 141   (require 'packages)
 142   (autoload 'package-get-info "package-get")
 143   (autoload 'paths-decode-directory-path "find-paths")
 144   (defvar package-get-install-to-user-init-directory))
 145
 146 (defun package-admin-find-top-directory (type &optional user-dir)
 147   "Return the top level directory for a package.
 148
 149 Argument TYPE is a symbol that determines the type of package we're
 150 trying to find a directory for.
 151
 152 Optional Argument USER-DIR if non-nil use directories off
 153 `user-init-directory'.  This overrides everything except
 154 \"EMACSPACKAGEPATH\".
 155
 156 This function honours the environment variable \"EMACSPACKAGEPATH\"
 157 and returns directories found there as a priority.  If that variable
 158 doesn't exist and USER-DIR is nil, check in the normal places.
 159
 160 If we still can't find a suitable directory, return nil.
 161
 162 Possible values for TYPE are:
 163
 164     std  == For \"standard\" packages that go in '/xemacs-packages/'
 165     mule == For \"mule\" packages that go in '/mule-packages/'
 166     site == For \"unsupported\" packages that go in '/site-packages/'
 167
 168 Note:  Type \"site\" is not yet fully supported."
 169   (let* ((env-value (getenv "EMACSPACKAGEPATH"))
 170          top-dir)
 171     ;; First, check the environment var.
 172     (if env-value
 173         (let ((path-list (paths-decode-directory-path env-value 'drop-empties)))
 174           (cond ((eq type 'std)
 175                  (while path-list
 176                    (if (equal (substring (car path-list) -16)
 177                               (concat "xemacs-packages" (char-to-string directory-sep-char)))
 178                        (setq top-dir (car path-list)))
 179                    (setq path-list (cdr path-list))))
 180                 ((eq type 'mule)
 181                  (while path-list
 182                    (if (equal (substring (car path-list) -14)
 183                               (concat "mule-packages" (char-to-string directory-sep-char)))
 184                        (setq top-dir (car path-list)))
 185                    (setq path-list (cdr path-list)))))))
 186     ;; Wasn't in the environment, try `user-init-directory' if
 187     ;; USER-DIR is non-nil.
 188     (if (and user-dir
 189              (not top-dir))
 190         (cond ((eq type 'std)
 191                (setq top-dir (file-name-as-directory
 192                               (expand-file-name "xemacs-packages" user-init-directory))))
 193               ((eq type 'mule)
 194                (setq top-dir (file-name-as-directory
 195                               (expand-file-name "mule-packages" user-init-directory))))))
 196     ;; Finally check the normal places
 197     (if (not top-dir)
 198         (let ((path-list (nth 1 (packages-find-packages
 199                                  emacs-roots
 200                                  (packages-compute-package-locations user-init-directory)))))
 201           (cond ((eq type 'std)
 202                  (while path-list
 203                    (if (equal (substring (car path-list) -16)
 204                               (concat "xemacs-packages" (char-to-string directory-sep-char)))
 205                        (setq top-dir (car path-list)))
 206                    (setq path-list (cdr path-list))))
 207                 ((eq type 'mule)
 208                  (while path-list
 209                    (if (equal (substring (car path-list) -14)
 210                               (concat "mule-packages" (char-to-string directory-sep-char)))
 211                        (setq top-dir (car path-list)))
 212                    (setq path-list (cdr path-list)))))))
 213     ;; Now return either the directory or nil.
 214     top-dir))
 215
 216 (defun package-admin-get-install-dir (package &optional pkg-dir)
 217   "Find a suitable installation directory for a package.
 218
 219 Argument PACKAGE is the package to find a installation directory for.
 220 Optional Argument PKG-DIR, if non-nil is a directory to use for
 221 installation.
 222
 223 If PKG-DIR is non-nil and writable, return that.  Otherwise check to
 224 see if the PACKAGE is already installed and return that location, if
 225 it is writable.  Finally, fall back to the `user-init-directory' if
 226 all else fails.  As a side effect of installing packages under
 227 `user-init-directory' these packages become part of `early-packages'."
 228   ;; If pkg-dir specified, return that if writable.
 229   (if (and pkg-dir
 230            (file-writable-p (directory-file-name pkg-dir)))
 231       pkg-dir
 232     ;; If the user want her packages under ~/.xemacs/, do so.
 233     (let ((type (package-get-info package 'category)))
 234       (if package-get-install-to-user-init-directory
 235           (progn
 236             (cond ((equal type "standard")
 237                    (setq pkg-dir (package-admin-find-top-directory 'std 'user-dir)))
 238                   ((equal type "mule")
 239                    (setq pkg-dir (package-admin-find-top-directory 'mule 'user-dir))))
 240             pkg-dir)
 241         ;; Maybe the package has been installed before, if so, return
 242         ;; that directory.
 243         (let ((package-feature (intern-soft (concat
 244                                              (symbol-name package) "-autoloads")))
 245               autoload-dir)
 246           (when (and (not (eq package 'unknown))
 247                      (featurep package-feature)
 248                      (setq autoload-dir (feature-file package-feature))
 249                      (setq autoload-dir (file-name-directory autoload-dir))
 250                      (member autoload-dir (append early-package-load-path late-package-load-path)))
 251             ;; Find the corresponding entry in late-package
 252             (setq pkg-dir
 253                   (car-safe (member-if (lambda (h)
 254                                          (string-match (concat "^" (regexp-quote h))
 255                                                        autoload-dir))
 256                                        (append (cdr early-packages) late-packages)))))
 257           (if (and pkg-dir
 258                    (file-writable-p (directory-file-name pkg-dir)))
 259               pkg-dir
 260             ;; OK, the package hasn't been previously installed so we need
 261             ;; to guess where it should go.
 262             (cond ((equal type "standard")
 263                    (setq pkg-dir (package-admin-find-top-directory 'std)))
 264                   ((equal type "mule")
 265                    (setq pkg-dir (package-admin-find-top-directory 'mule)))
 266                   (t
 267                    (error 'invalid-operation
 268                           "Invalid package type")))
 269             (if (and pkg-dir
 270                      (file-writable-p (directory-file-name pkg-dir)))
 271                 pkg-dir
 272               ;; Oh no!  Either we still haven't found a suitable
 273               ;; directory, or we can't write to the one we did find.
 274               ;; Drop back to the `user-init-directory'.
 275               (if (y-or-n-p (format "Directory isn't writable, use %s instead? "
 276                                     user-init-directory))
 277                   (progn
 278                     (cond ((equal type "standard")
 279                            (setq pkg-dir (package-admin-find-top-directory 'std 'user-dir)))
 280                           ((equal type "mule")
 281                            (setq pkg-dir (package-admin-find-top-directory 'mule 'user-dir)))
 282                           (t
 283                            (error 'invalid-operation
 284                                   "Invalid package type")))
 285                     ;; Turn on `package-get-install-to-user-init-directory'
 286                     ;; so we don't get asked for each package we try to
 287                     ;; install in this session.
 288                     (setq package-get-install-to-user-init-directory t)
 289                     pkg-dir)
 290                 ;; If we get to here XEmacs can't make up its mind and
 291                 ;; neither can the user, nothing left to do except barf. :-(
 292                 (error 'search-failed
 293                        (format
 294                         "Can't find suitable installation directory for package: %s"
 295                         package))))))))))
 296
 297 (defun package-admin-get-manifest-file (pkg-topdir package)
 298   "Return the name of the MANIFEST file for package PACKAGE.
 299 Note that PACKAGE is a symbol, and not a string."
 300   (let ((dir (file-name-as-directory
 301               (expand-file-name "pkginfo" pkg-topdir))))
 302     (expand-file-name (concat "MANIFEST." (symbol-name package)) dir)))
 303
 304 (defun package-admin-check-manifest (pkg-outbuf pkg-topdir)
 305   "Check for a MANIFEST.<package> file in the package distribution.
 306 If it doesn't exist, create and write one.
 307 PKG-OUTBUF is the buffer that holds the output from `tar', and PKG-TOPDIR
 308 is the top-level directory under which the package was installed."
 309   (let ((manifest-buf " *pkg-manifest*")
 310         (old-case-fold-search case-fold-search)
 311         regexp package-name pathname regexps)
 312     (unwind-protect
 313         (save-excursion                         ;; Probably redundant.
 314           (set-buffer (get-buffer pkg-outbuf))  ;; Probably already the current buffer.
 315           (goto-char (point-min))
 316
 317           ;; Make filenames case-insensitive, if necessary
 318           (if (eq system-type 'windows-nt)
 319               (setq case-fold-search t))
 320
 321           (setq regexp (concat "\\bpkginfo"
 322                                (char-to-string directory-sep-char)
 323                                "MANIFEST\\...*"))
 324
 325           ;; Look for the manifest.
 326           (if (not (re-search-forward regexp nil t))
 327               (progn
 328                 ;; We didn't find a manifest.  Make one.
 329
 330                 ;; Yuk.  We weren't passed the package name, and so we have
 331                 ;; to dig for it.  Look for it as the subdirectory name below
 332                 ;; "lisp", or "man".
 333                 ;; Here, we don't use a single regexp because we want to search
 334                 ;; the directories for a package name in a particular order.
 335                 (if (catch 'done
 336                       (let ((dirs '("lisp" "man"))
 337                             rexp)
 338                         (while dirs
 339                           (setq rexp (concat "\\b" (car dirs)
 340                                              "[\\/]\\([^\\/]+\\)[\//]"))
 341                           (if (re-search-forward rexp nil t)
 342                               (throw 'done t))
 343                           (setq dirs (cdr dirs)))))
 344                     (progn
 345                       (setq package-name (buffer-substring (match-beginning 1)
 346                                                            (match-end 1)))
 347
 348                       ;; Get and erase the manifest buffer
 349                       (setq manifest-buf (get-buffer-create manifest-buf))
 350                       (buffer-disable-undo manifest-buf)
 351                       (erase-buffer manifest-buf)
 352
 353                       ;; Now, scan through the output buffer, looking for
 354                       ;; file and directory names.
 355                       (goto-char (point-min))
 356                       ;; for each line ...
 357                       (while (< (point) (point-max))
 358                         (beginning-of-line)
 359                         (setq pathname nil)
 360
 361                         ;; scan through the regexps, looking for a pathname
 362                         (if (catch 'found-path
 363                               (setq regexps package-admin-tar-filename-regexps)
 364                               (while regexps
 365                                 (if (looking-at (car regexps))
 366                                     (progn
 367                                       (setq pathname
 368                                             (buffer-substring
 369                                              (match-beginning 1)
 370                                              (match-end 1)))
 371                                       (throw 'found-path t)))
 372                                 (setq regexps (cdr regexps))))
 373                             (progn
 374                               ;; found a pathname -- add it to the manifest
 375                               ;; buffer
 376                               (save-excursion
 377                                 (set-buffer manifest-buf)
 378                                 (goto-char (point-max))
 379                                 (insert pathname "\n"))))
 380                         (forward-line 1))
 381
 382                       ;; Processed all lines.
 383                       ;; Now, create the file, pkginfo/MANIFEST.<pkgname>
 384
 385                       ;; We use `expand-file-name' instead of `concat',
 386                       ;; for portability.
 387                       (setq pathname (expand-file-name "pkginfo"
 388                                                        pkg-topdir))
 389                       ;; Create pkginfo, if necessary
 390                       (if (not (file-directory-p pathname))
 391                           (make-directory pathname))
 392                       (setq pathname (expand-file-name
 393                                       (concat "MANIFEST." package-name)
 394                                       pathname))
 395                       (save-excursion
 396                         (set-buffer manifest-buf)
 397                         ;; Put the files in sorted order
 398                         (if (fboundp 'sort-lines)
 399                             (sort-lines nil (point-min) (point-max))
 400                           (warn "`xemacs-base' not installed, MANIFEST.%s not sorted"
 401                                 package-name))
 402                         ;; Write the file.
 403                         ;; Note that using `write-region' *BYPASSES* any check
 404                         ;; to see if XEmacs is currently editing/visiting the
 405                         ;; file.
 406                         (write-region (point-min) (point-max) pathname))
 407                       (kill-buffer manifest-buf))))))
 408       ;; Restore old case-fold-search status
 409       (setq case-fold-search old-case-fold-search))))
 410
 411 ;;;###autoload
 412 (defun package-admin-add-binary-package (file &optional pkg-dir)
 413   "Install a pre-bytecompiled XEmacs package into package hierarchy."
 414   (interactive "fPackage tarball: ")
 415   (let ((buf (get-buffer-create package-admin-temp-buffer))
 416         (status 1)
 417         start err-list)
 418     (setq pkg-dir (package-admin-get-install-dir 'unknown pkg-dir))
 419     ;; Ensure that the current directory doesn't change
 420     (save-excursion
 421       (set-buffer buf)
 422       ;; This is not really needed
 423       (setq default-directory (file-name-as-directory pkg-dir))
 424       (setq case-fold-search t)
 425       (buffer-disable-undo)
 426       (goto-char (setq start (point-max)))
 427       (if (= 0 (setq status (funcall package-admin-install-function
 428                                      file pkg-dir buf)))
 429           (progn
 430             ;; First, check for errors.
 431             ;; We can't necessarily rely upon process error codes.
 432             (catch 'done
 433               (goto-char start)
 434               (setq err-list package-admin-error-messages)
 435               (while err-list
 436                 (if (re-search-forward (car err-list) nil t)
 437                     (progn
 438                       (setq status 1)
 439                       (throw 'done nil)))
 440                 (setq err-list (cdr err-list))))
 441             ;; Make sure that the MANIFEST file exists
 442             (package-admin-check-manifest buf pkg-dir))))
 443     status))
 444
 445 (defun package-admin-rmtree (directory)
 446   "Delete a directory and all of its contents, recursively.
 447 This is a feeble attempt at making a portable rmdir."
 448   (setq directory (file-name-as-directory directory))
 449   (let ((files (directory-files directory nil nil nil t))
 450         (dirs (directory-files directory nil nil nil 'dirs)))
 451     (while dirs
 452       (if (not (member (car dirs) '("." "..")))
 453           (let ((dir (expand-file-name (car dirs) directory)))
 454             (condition-case err
 455                 (if (file-symlink-p dir) ;; just in case, handle symlinks
 456                     (delete-file dir)
 457                   (package-admin-rmtree dir))
 458               (file-error
 459                (message "%s: %s: \"%s\"" (nth 1 err) (nth 2 err) (nth 3 err)))))
 460         (setq dirs (cdr dirs))))
 461     (while files
 462       (condition-case err
 463           (delete-file (expand-file-name (car files) directory))
 464         (file-error
 465          (message "%s: %s: \"%s\"" (nth 1 err) (nth 2 err) (nth 3 err))))
 466       (setq files (cdr files)))
 467     (condition-case err
 468         (delete-directory directory)
 469       (file-error
 470        (message "%s: %s: \"%s\"" (nth 1 err) (nth 2 err) (nth 3 err))))))
 471
 472 (defun package-admin-get-lispdir  (pkg-topdir package)
 473   (let (package-lispdir)
 474     (if (and (setq package-lispdir (expand-file-name "lisp" pkg-topdir))
 475              (setq package-lispdir (expand-file-name (symbol-name package)
 476                                                      package-lispdir))
 477              (file-accessible-directory-p package-lispdir))
 478         package-lispdir)))
 479
 480 (defun package-admin-delete-binary-package (package pkg-topdir)
 481   "Delete a binary installation of PACKAGE below directory PKG-TOPDIR.
 482 PACKAGE is a symbol, not a string."
 483   (let (manifest-file package-lispdir dirs file)
 484     (setq pkg-topdir (package-admin-get-install-dir package pkg-topdir))
 485     (setq manifest-file (package-admin-get-manifest-file pkg-topdir package))
 486     (run-hook-with-args 'package-delete-hook package pkg-topdir)
 487     (if (file-exists-p manifest-file)
 488         (progn
 489           ;; The manifest file exists!  Use it to delete the old distribution.
 490           (message "Removing old files for package \"%s\" ..." package)
 491           (sit-for 0)
 492           (with-temp-buffer
 493             (buffer-disable-undo)
 494             (erase-buffer)
 495             (insert-file-contents manifest-file)
 496             (goto-char (point-min))
 497
 498             ;; For each entry in the MANIFEST ...
 499             (while (< (point) (point-max))
 500               (beginning-of-line)
 501               (setq file (expand-file-name (buffer-substring
 502                                             (point)
 503                                             (point-at-eol))
 504                                            pkg-topdir))
 505               (if (file-directory-p file)
 506                   ;; Keep a record of each directory
 507                   (setq dirs (cons file dirs))
 508                   ;; Delete each file.
 509                   ;; Make sure that the file is writable.
 510                   ;; (This is important under MS Windows.)
 511                   ;; I do not know why it important under MS Windows but
 512                   ;;    1. It bombs out when the file does not exist. This can be condition-cased
 513                   ;;    2. If I removed the write permissions, I do not want XEmacs to just ignore them.
 514                   ;;       If it wants to, XEmacs may ask, but that is about all
 515                   ;; (set-file-modes file 438) ;; 438 -> #o666
 516                   ;; Note, user might have removed the file!
 517                 (condition-case ()
 518                     (delete-file file)
 519                   (error nil)))         ;; We may want to turn the error into a Warning?
 520               (forward-line 1))
 521
 522             ;; Delete empty directories.
 523             (if dirs
 524                 (progn
 525                   (mapc
 526                    (lambda (dir)
 527                      (condition-case ()
 528                          (delete-directory dir)))
 529                    dirs)))
 530           ;; Delete the MANIFEST file
 531           ;; (set-file-modes manifest-file 438) ;; 438 -> #o666
 532           ;; Note. Packages can have MANIFEST in MANIFEST.
 533           (condition-case ()
 534               (delete-file manifest-file)
 535             (error nil)) ;; Do warning?
 536           (message "Removing old files for package \"%s\" ... done" package)))
 537       ;; The manifest file doesn't exist.  Fallback to just deleting the
 538       ;; package-specific lisp directory, if it exists.
 539       ;;
 540       ;; Delete old lisp directory, if any
 541       ;; Gads, this is ugly.  However, we're not supposed to use `concat'
 542       ;; in the name of portability.
 543       (setq package-lispdir (package-admin-get-lispdir pkg-topdir package))
 544       (when package-lispdir
 545         (message "Removing old lisp directory \"%s\" ..." package-lispdir)
 546         (sit-for 0)
 547         (package-admin-rmtree package-lispdir)
 548         (message "Removing old lisp directory \"%s\" ... done" package-lispdir)))
 549     ;; Delete the package from the database of installed packages.
 550     (package-delete-name package)))
 551
 552 (provide 'package-admin)
 553
 554 ;;; package-admin.el ends here