[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
package.el 0.1 - simple package manager
|
From: |
Tom Tromey |
|
Subject: |
package.el 0.1 - simple package manager |
|
Date: |
14 Mar 2007 18:52:50 -0600 |
|
User-agent: |
Gnus/5.09 (Gnus v5.9.0) Emacs/21.4 |
Here is a newer version of package.el.
This version adds a few features:
* M-x package-list-packages is a buffer-menu-like mode that lists all
the packages. You can use "r" in this mode to re-fetch the ELPA
package list from the server; this will let you see what is
available for installation.
* You can now use M-x package-install-from-buffer to install a package
which comes from a single file. The file must follow the Emacs Lisp
comment conventions, with the caveat that the "version" header's
value must be a simple dotted list of numbers. (package.el defines
a new "package-version" header, along with a couple other
extensions, to make future single-file packages simpler to install.)
Please try it out and send feedback -- not just about bugs but also
the advisability of this idea, advice for getting it into Emacs
proper, feature requests, etc.
Aside from some bug fixes and a couple minor features (see the to do
list near the top), one remaining major idea is to write a bit of code
that interfaces with 'desktop' so that it is possible to upgrade a
package and then restart Emacs while appearing to preserve the current
session.
Tom
;;; package.el - Simple package system for Emacs
;; Copyright (C) 2007 Tom Tromey <address@hidden>
;; Author: Tom Tromey <address@hidden>
;; Created: 10 Mar 2007
;; Version: 0.1
;; Keywords: tools
;; This file is not (yet) part of GNU Emacs.
;; However, it is distributed under the same license.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Change Log:
;; 14 Mar 2007 - Changed how obsolete packages are handled
;; 13 Mar 2007 - Wrote package-install-from-buffer
;; 12 Mar 2007 - Wrote package-menu mode
;;; Commentary:
;; The idea is to be able to download packages and install them.
;; Packages are versioned and have versioned dependencies.
;; Furthermore, this supports built-in packages which may or may not
;; be newer than user-specified packages. This makes it possible to
;; upgrade Emacs and automatically disable packages which have moved
;; from external to core. (Note though that we don't currently
;; register any of these, so this feature does not actually work.)
;; This code supports a single package repository, ELPA. All packages
;; must be registered there.
;; A package is described by its name and version. The distribution
;; format is simply a tar file, named "NAME-VERSION.tar". The tar
;; file must unpack into a directory named after the package and
;; version: "NAME-VERSION". It must contain a file named
;; "PACKAGE-pkg.el" which consists of a call to define-package. It
;; may also contain a "dir" file and the info files it references.
;; The downloader will download all dependent packages. It will also
;; byte-compile the package's lisp at install time.
;; At activation time we will set up the load-path and the info path,
;; and we will load the package's autoloads. If a package's
;; dependencies are not available, we will not activate that package.
;;; ToDo:
;; - Use hierarchical layout. PKG/etc PKG/lisp PKG/info
;; ... except maybe lisp?
;; - It may be nice to have a macro that expands to the package's
;; private data dir, aka ".../etc". Or, maybe data-directory
;; needs to be a list (though this would be less nice)
;; - need to implement package deletion
;; - package menu needs:
;; font locking
;; ability to know which packages are built-in & thus not deletable
;; it can sometimes print odd results, like 0.3 available but 0.4 active
;; why is that?
;; - Allow multiple versions on the server...?
;; [ why bother? ]
;; - Don't install a package which will invalidate dependencies overall
;; - Allow something like (or (>= emacs 21.0) (>= xemacs 21.5))
;; [ currently thinking, why bother.. KISS ]
;; - Allow optional package dependencies
;; then if we require 'bbdb', bbdb-specific lisp in lisp/bbdb
;; and just don't compile to add to load path ...?
;; - Have a list of archive URLs. Allow ssh URLs? Does url interface
;; with tramp?
;; - David Kastrup pointed out on the xemacs list that for GPL it
;; is friendlier to ship the source tree. We could "support" that
;; by just having a "src" subdir in the package. This isn't ideal
;; but it probably is not worth trying to support random source
;; tree layouts, build schemes, etc.
;; - Our treatment of the info path is somewhat bogus
;; - Would be nice to have some tools for managing ELPA itself
;;; Code:
(defconst package-archive-base "http://tromey.com/elpa/";
"Base URL for the package archive.
Ordinarily you should not need to edit this.
The default points to ELPA, the Emacs Lisp Package Archive.")
;; Prime the cache.
(defvar package-archive-contents
'((bubbles . [(0 2) nil nil "Bubbles (same game) puzzle" nil])
(newsticker . [(1 10) nil nil "Headline news ticker" nil])
)
"A representation of the contents of the ELPA archive.
This is an alist mapping package names (symbols) to package
descriptor vectors.")
(defvar package-user-dir (expand-file-name "~/.emacs.d/elpa")
"Name of the directory where the user's packages are stored.")
(defvar package-directory-list
(list (file-name-as-directory package-user-dir)
"/usr/share/emacs/site-lisp/elpa/")
"List of directories to search for packages.")
(defvar package-alist
`((emacs . [(,emacs-major-version ,emacs-minor-version) nil nil
"GNU Emacs"]))
"Alist of all packages available for activation.
Maps the package name to a vector [VERSION REQS BODY DOCSTRING].")
(defvar package-activated-list '(emacs)
"List of the names of all activated packages.")
(defvar package-obsolete-alist nil
"Representation of obsolete packages.
Like package-alist, but maps package name to a second alist.
The inner alist is keyed by version.")
(defun package-version-split (string)
"Split a package string into a version list."
(mapcar 'string-to-int (split-string string "[.]")))
(defun package-version-join (l)
"Turn a list of version numbers into a version string."
(mapconcat 'int-to-string l "."))
(defun package-version-compare (v1 v2 fun)
"Compare two version lists according to FUN.
FUN can be <, <=, =, >, >=, or /=."
(while (and v1 v2 (= (car v1) (car v2)))
(setq v1 (cdr v1))
(setq v2 (cdr v2)))
(setq v1 (if v1 (car v1) 0))
(setq v2 (if v2 (car v2) 0))
(funcall fun v1 v2))
(defun package-strip-version (dirname)
"Strip the version from a combined package name and version.
E.g., if given \"quux-23.0\", will return \"quux\""
(if (string-match "^\\(.*\\)-[0-9]+\\([.][0-9]+\\)*$" dirname)
(match-string 1 dirname)))
(defun package-load-descriptor (dir package)
"Load the description file for a package.
Return nil if the package could not be found."
(let ((pkg-dir (concat (file-name-as-directory dir) package "/")))
(if (file-directory-p pkg-dir)
(load (concat pkg-dir (package-strip-version package) "-pkg") nil t))))
(defun package-load-all-descriptors ()
"Load descriptors of all packages.
Uses `package-directory-list' to find packages."
(mapc (lambda (dir)
(if (file-directory-p dir)
(mapc (lambda (name)
(package-load-descriptor dir name))
(directory-files dir nil "^[^.]"))))
package-directory-list))
(defun package-do-activate (package pkg-vec)
(let* ((activate-body (aref pkg-vec 2))
(pkg-name (symbol-name package))
(pkg-ver-str (package-version-join (aref pkg-vec 0)))
(dir-list package-directory-list)
(pkg-dir))
(while dir-list
(let ((subdir (concat (car dir-list) pkg-name "-" pkg-ver-str "/")))
(when (file-directory-p subdir)
(setq pkg-dir subdir)
(setq dir-list nil))))
(unless pkg-dir
(error "Internal error: could not find directory for %s-%s"
pkg-name pkg-ver-str))
(if (file-exists-p (concat pkg-dir "dir"))
(progn
;; FIXME: not the friendliest, but simple.
(require 'info)
(info-initialize)
(setq Info-directory-list (cons pkg-dir Info-directory-list))))
(setq load-path (cons pkg-dir load-path))
;; Load the autoloads and activate the package.
(load (concat pkg-dir (symbol-name package) "-autoloads")
nil t)
(eval `(progn ,@activate-body))
(setq package-activated-list
(cons package package-activated-list))
;; Don't return nil.
t))
;; FIXME: return a reason instead?
(defun package-activate (package version)
"Try to activate a package.
Return nil if the package could not be activated.
Recursively activates all dependencies of the named package."
(or (memq package package-activated-list)
(let* ((pkg-desc (assq package package-alist))
(this-version (aref (cdr pkg-desc) 0))
(req-list (aref (cdr pkg-desc) 1))
(keep-going (package-version-compare this-version version '>=)))
(while (and req-list keep-going)
(or (package-activate (car (car req-list))
(car (cdr (car req-list))))
(setq keep-going nil))
(setq req-list (cdr req-list)))
(if keep-going
(package-do-activate package (cdr pkg-desc))))))
(defun package-mark-obsolete (package pkg-vec)
"Put package on the obsolete list, if not already there."
(let ((elt (assq package package-obsolete-alist)))
(if elt
;; If this obsolete version does not exist in the list, update
;; it the list.
(unless (assoc (aref pkg-vec 0) (cdr elt))
(setcdr elt (cons (cons (aref pkg-vec 0) pkg-vec) (cdr elt))))
;; Make a new association.
(setq package-obsolete-alist
(cons (cons package (list (cons (aref pkg-vec 0) pkg-vec)))
package-obsolete-alist)))))
;; (define-package "emacs" "21.4.1" "GNU Emacs core package.")
;; (define-package "erc" "5.1" "ERC - irc client" '((emacs "21.0")))
(defun define-package (name-str version-string
&optional docstring
&optional requirements
&rest body)
"Define a new package.
NAME is the name of the package, a string.
VERSION-STRING is the version of the package, a dotted sequence
of integers.
DOCSTRING is the optional description.
REQUIREMENTS is a list of requirements on other packages.
Each requirement is of the form (OTHER-PACKAGE \"VERSION\").
BODY is a form to be evaluated when the package is activated.
Note that the package's autoloads are automatically processed
on activation; so BODY should not usually be needed."
(let* ((name (intern name-str))
(pkg-desc (assq name package-alist))
(new-version (package-version-split version-string))
(new-pkg-desc
(cons name
(vector new-version
(if requirements
(mapcar
(lambda (elt)
(list (car elt)
(package-version-split (car (cdr elt)))))
requirements))
body
docstring))))
;; Only redefine a package if the redefinition is newer.
(if (or (not pkg-desc)
(package-version-compare new-version (aref (cdr pkg-desc) 0) '>))
(progn
(when pkg-desc
;; Remove old package and declare it obsolete.
(setq package-alist (delq pkg-desc package-alist))
(package-mark-obsolete (car pkg-desc) (cdr pkg-desc)))
;; Add package to the alist.
(setq package-alist (cons new-pkg-desc package-alist)))
;; The package is born obsolete.
(package-mark-obsolete (car new-pkg-desc) (cdr new-pkg-desc)))))
(defun package-generate-autoloads (name pkg-dir)
(let* ((auto-name (concat name "-autoloads.el"))
(ignore-name (concat name "-pkg.el"))
(generated-autoload-file (concat pkg-dir auto-name))
(version-control 'never))
;; In Emacs 22 'update-autoloads-from-directories' does not seem
;; to be autoloaded...
(require 'autoload)
(update-autoloads-from-directories pkg-dir)))
(defun package-unpack (name version)
(let ((pkg-dir (concat (file-name-as-directory package-user-dir)
(symbol-name name) "-" version "/")))
;; Be careful!!
(make-directory package-user-dir t)
(if (file-directory-p pkg-dir)
(mapc (lambda (file) nil) ; 'delete-file
(directory-files pkg-dir t "^[^.]")))
(let ((default-directory (file-name-as-directory package-user-dir)))
;; FIXME check the result?
;; FIXME: use tar-untar-buffer
(call-process-region (point) (point-max) "tar" nil '(nil nil) nil
"xf" "-")
(package-generate-autoloads (symbol-name name) pkg-dir)
;; do we need to set load-path here?
(byte-recompile-directory pkg-dir 0 t))))
(defun package-download (name version)
(let ((tar-buffer (url-retrieve-synchronously
(concat package-archive-base
(symbol-name name) "-" version ".tar"))))
(save-excursion
(set-buffer tar-buffer)
(goto-char (point-min))
(re-search-forward "^$" nil 'move)
(forward-char)
(package-unpack name version)
(kill-buffer tar-buffer))))
(defun package-installed-p (package version)
(let ((pkg-desc (assq package package-alist)))
(and pkg-desc
(package-version-compare version (aref (cdr pkg-desc) 0) '>=))))
(defun package-compute-transaction (result requirements)
(while requirements
(let* ((elt (car requirements))
(next-pkg (car elt))
(next-version (car (cdr elt))))
(unless (package-installed-p next-pkg next-version)
(let ((pkg-desc (assq next-pkg package-archive-contents)))
(unless pkg-desc
(error "Package '%s' not available for installation."
(symbol-name next-pkg)))
(unless (package-version-compare (aref (cdr pkg-desc) 0)
next-version
'>=)
(error
"Need package '%s' with version %s, but only %s is available."
(symbol-name next-pkg) (package-version-join next-version)
(package-version-join (aref (cdr pkg-desc) 0))))
;; Only add to the transaction if we don't already have it.
(unless (memq next-pkg result)
(setq result (cons next-pkg result)))
(setq result
(package-compute-transaction result
(aref (cdr pkg-desc) 1))))))
(setq requirements (cdr requirements)))
result)
(defun package-read-archive-contents ()
"Re-read archive-contents.el, if it exists."
(load (concat (file-name-as-directory package-user-dir)
"archive-contents")
t))
(defun package-download-transaction (transaction)
(mapc (lambda (elt)
(let ((v-string (package-version-join
(aref (cdr (assq elt package-archive-contents))
0))))
(package-download elt v-string)))
transaction))
(defun package-install (name)
"Install the package named NAME."
(interactive
(list (progn
;; Make sure we're using the most recent download of the
;; archive. Maybe we should be updating the archive first?
(package-read-archive-contents)
(intern (completing-read "Install package: "
(mapcar (lambda (elt)
(cons (symbol-name (car elt))
nil))
package-archive-contents)
nil t)))))
(let ((pkg-desc (assq name package-archive-contents)))
(unless pkg-desc
(error "Package '%s' not available for installation."
(symbol-name name)))
(let ((transaction
(package-compute-transaction (list name) (aref (cdr pkg-desc) 1))))
(package-download-transaction transaction)))
;; Try to activate it.
(package-initialize))
(defun package-install-from-buffer ()
"Install a package from the current buffer.
The package is assumed to be a single .el file which
follows the elisp comment guidelines; see
info node `(elisp)Library Headers'."
(interactive)
(save-excursion
(goto-char (point-min))
(if (re-search-forward "^;;; \\([^ ]*\\)\\.el --- " nil t)
(let ((file-name (match-string 1))
(start (progn (beginning-of-line) (point))))
(when (search-forward (concat ";;; " file-name ".el ends here"))
(save-restriction
(narrow-to-region start (point))
;; FIXME: Is this ok to do?
(require 'lisp-mnt)
;; Use some headers we've invented to drive the process.
(let* ((requires-str (lm-header "package-requires"))
(requires (if requires-str
(read-from-whole-string requires-str)))
(desc (lm-header "package-description"))
;; Can't just always use "version" because that
;; might return an SCCS id or something equally
;; un-useful for our purposes.
(version-str (lm-header "version"))
(pkg-version
(if (and version-str
(string-match "^[0-9.]*$" version-str))
version-str
(lm-header "package-version"))))
(unless pkg-version
(error
"Package does not define a usable \"Version\" or
\"Package-Version\" header."))
;; Download and install the dependencies.
(let ((transaction (package-compute-transaction nil requires)))
(package-download-transaction transaction))
;; Install the package itself.
(let* ((dir (file-name-as-directory package-user-dir))
(pkg-dir (file-name-as-directory
(concat dir file-name "-" pkg-version))))
(make-directory pkg-dir t)
(write-region (point-min) (point-max)
(concat pkg-dir file-name ".el")
nil nil nil 'excl)
(set-text-properties 0 (length file-name) nil file-name)
(set-text-properties 0 (length pkg-version) nil pkg-version)
(set-text-properties 0 (length desc) nil desc)
(write-region (concat
(prin1-to-string (list 'define-package
file-name
pkg-version
desc
requires))
"\n")
nil
(concat pkg-dir file-name "-pkg.el")
nil nil nil 'excl)
(package-generate-autoloads file-name pkg-dir)
;; do we need to set load-path here?
(byte-recompile-directory pkg-dir 0 t))
;; Try to activate it.
(package-initialize))))))))
(defun package-refresh-contents ()
"Download the ELPA archive description if needed.
Invoking this will ensure that Emacs knows about the latest versions
of all packages. This will let Emacs make them available for
download."
(interactive)
(let ((buffer (url-retrieve-synchronously
(concat package-archive-base "archive-contents.el"))))
(save-excursion
(set-buffer buffer)
(goto-char (point-min))
(re-search-forward "^$" nil 'move)
(forward-char)
(delete-region (point-min) (point))
(setq buffer-file-name (concat (file-name-as-directory package-user-dir)
"archive-contents.el"))
(let ((version-control 'never))
(save-buffer))
(kill-buffer buffer)))
(package-read-archive-contents))
(defun package-initialize ()
"Load all packages and activate as many as possible."
(package-load-all-descriptors)
(package-read-archive-contents)
;; Try to activate all our packages.
(mapc (lambda (elt)
(package-activate (car elt) (aref (cdr elt) 0)))
package-alist))
;;;; Package menu mode.
(defvar package-menu-mode-map nil
"Local keymap for `package-menu-mode' buffers.")
(unless package-menu-mode-map
(setq package-menu-mode-map (make-keymap))
(suppress-keymap package-menu-mode-map)
(define-key package-menu-mode-map "q" 'quit-window)
(define-key package-menu-mode-map "n" 'next-line)
(define-key package-menu-mode-map "p" 'previous-line)
(define-key package-menu-mode-map "u" 'package-menu-mark-unmark)
(define-key package-menu-mode-map "\177" 'package-menu-backup-unmark)
(define-key package-menu-mode-map "d" 'package-menu-mark-delete)
(define-key package-menu-mode-map "i" 'package-menu-mark-install)
(define-key package-menu-mode-map "g" 'package-menu-revert)
(define-key package-menu-mode-map "r" 'package-menu-fetch)
(define-key package-menu-mode-map "~"
'package-menu-mark-obsolete-for-deletion)
(define-key package-menu-mode-map "x" 'package-menu-execute)
)
(put 'package-menu-mode 'mode-class 'special)
(defun package-menu-mode ()
"Major mode for browsing a list of packages.
Letters do not insert themselves; instead, they are commands."
(kill-all-local-variables)
(use-local-map package-menu-mode-map)
(setq major-mode 'package-menu-mode)
(setq mode-name "Package Menu")
(setq truncate-lines t)
(setq buffer-read-only t)
(run-mode-hooks 'package-menu-mode-hook))
(defun package-menu-fetch ()
"Download the ELPA archive.
This fetches the file describing the current contents of
the Emacs Lisp Package Archive, and then refreshes the
package menu. This lets you see what new packages are
available for download."
(interactive)
(package-refresh-contents)
(package-list-packages-internal))
(defun package-menu-revert ()
"Update the list of packages."
(interactive)
(package-list-packages-internal))
(defun package-menu-mark-internal (what)
(unless (eobp)
(let ((buffer-read-only nil))
(beginning-of-line)
(delete-char 1)
(insert what)
(forward-line))))
;; fixme numeric argument
(defun package-menu-mark-delete (num)
"Mark a package for deletion and move to the next line."
(interactive "p")
(package-menu-mark-internal "D"))
(defun package-menu-mark-install (num)
"Mark a package for installation and move to the next line."
(interactive "p")
(package-menu-mark-internal "I"))
(defun package-menu-mark-unmark (num)
"Clear any marks on a package and move to the next line."
(interactive "p")
(package-menu-mark-internal " "))
(defun package-menu-backup-unmark ()
"Back up one line and clear any marks on that package."
(interactive)
(forward-line -1)
(package-menu-mark-internal " ")
(forward-line -1))
(defun package-menu-mark-obsolete-for-deletion ()
"Mark all obsolete packages for deletion."
(interactive)
(save-excursion
(goto-char (point-min))
(forward-line 2)
(while (not (eobp))
(if (looking-at ".* obsolete$")
(package-menu-mark-internal "D")
(forward-line 1)))))
(defun package-menu-get-package ()
(save-excursion
(beginning-of-line)
(if (looking-at ". \\([^ \t]*\\)")
(match-string 1))))
(defun package-menu-get-version ()
(save-excursion
(beginning-of-line)
(if (looking-at ". [^ \t]*[ \t]*\\([0-9.]*\\)")
(match-string 1))))
(defun package-menu-get-status ()
(save-excursion
(if (looking-at ".*[ \t]\\([^ \t]*\\)$")
(match-string 1)
"")))
(defun package-menu-execute ()
"Perform all the marked actions.
Packages marked for installation will be downloaded and
installed. Packages marked for deletion will be removed.
Note that after installing packages you will want to restart
Emacs."
(interactive)
(goto-char (point-min))
(forward-line 2)
(while (not (eobp))
(let ((cmd (char-after))
(pkg-name (package-menu-get-package))
(pkg-vers (package-menu-get-version))
(pkg-status (package-menu-get-status)))
(cond
((eq cmd ?D)
(if (string= pkg-status "")
;; FIXME: ask for confirmation.
nil))
((eq cmd ?I)
(package-install (intern pkg-name)))))
(forward-line))
(package-menu-revert))
(defun package-print-package (package version key)
(insert " ")
(insert (symbol-name package))
(indent-to 20 1)
(insert (package-version-join version))
(indent-to 30 1)
(insert key)
(insert "\n"))
(defun package-list-maybe-add (package version status result)
(let ((elt (assoc (cons package version) result)))
(unless elt
(setq result (cons (cons (cons package version) status) result))))
result)
(defun package-list-packages-internal ()
(package-initialize) ; FIXME: do this here?
(with-current-buffer (get-buffer-create "*Packages*")
(setq buffer-read-only nil)
(erase-buffer)
(let ((info-list))
(mapc (lambda (elt)
(setq info-list
(package-list-maybe-add (car elt)
(aref (cdr elt) 0)
;; FIXME: it turns out to
;; be tricky to see if
;; this package is
;; presently activated.
;; That is lame!
""
info-list)))
package-alist)
(mapc (lambda (elt)
(setq info-list (package-list-maybe-add (car elt)
(aref (cdr elt) 0)
"available"
info-list)))
package-archive-contents)
(mapc (lambda (elt)
(mapc (lambda (inner-elt)
(setq info-list
(package-list-maybe-add (car elt)
(aref (cdr inner-elt) 0)
"obsolete"
info-list)))
(cdr elt)))
package-obsolete-alist)
(mapc (lambda (elt)
(package-print-package (car (car elt))
(cdr (car elt))
(cdr elt)))
info-list))
(sort-lines nil (point-min) (point-max))
(goto-char (point-min))
(insert " ")
(insert "Package")
(indent-to 20 1)
(insert "Version")
(indent-to 30 1)
(insert "Status")
(insert "\n")
(insert " ")
(insert "-------")
(indent-to 20 1)
(insert "-------")
(indent-to 30 1)
(insert "------")
(insert "\n")
(current-buffer)))
(defun package-list-packages ()
"Display a list of packages.
The list is displayed in a buffer named `*Packages*'."
(interactive)
(with-current-buffer (package-list-packages-internal)
(package-menu-mode)
;; switch-to-buffer-other-window??
(display-buffer (current-buffer))))
;;; package.el ends here