andros/emacs-gpu
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

* lisp/emacs-lisp/package.el: Don't activate packages older than builtin.

Browse source 
(package-obsolete-list): Rename from package-obsolete-alist, and make
it into a simple list of package-desc.
(package-strip-version): Remove.
(package-built-in-p): Use package--builtin-versions.
(package-mark-obsolete): Simplify.
(package-process-define-package): Mark it obsolete if older than the
builtin version.
(package-handle-response): Use line-end-position.
(package-read-archive-contents, package--download-one-archive):
Simplify.
(package--add-to-archive-contents): Skip if older than the builtin or
installed version.
(package-menu-describe-package): Fix last change.
(package-list-unversioned): New var.
(package-menu--generate): Use it.

* lisp/Makefile.in (autoloads): Set autoload-builtin-package-versions.

* lisp/startup.el (package--builtin-versions): New var.
(package-subdirectory-regexp): Remove.
(package--description-file): Hard code its value instead.

* lisp/emacs-lisp/autoload.el: Manage package--builtin-versions.
(autoload--insert-text, autoload--insert-cookie-text): New functions.
(autoload-builtin-package-versions): New variable.
(autoload-generate-file-autoloads): Use them.
Remove the list of autoloaded functions/macros from the
(autoload...) comments.
This commit is contained in:
Stefan Monnier 2013-06-15 11:36:11 -04:00
parent d862673b61
commit 66bd25ab33
7 changed files with 187 additions and 142 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

32
lisp/ChangeLog
View file

@ -1,3 +1,35 @@
2013-06-15 Stefan Monnier <monnier@iro.umontreal.ca>
* startup.el (package--builtin-versions): New var.
(package-subdirectory-regexp): Remove.
(package--description-file): Hard code its value instead.
* emacs-lisp/package.el: Don't activate packages older than builtin.
(package-obsolete-list): Rename from package-obsolete-alist, and make
it into a simple list of package-desc.
(package-strip-version): Remove.
(package-built-in-p): Use package--builtin-versions.
(package-mark-obsolete): Simplify.
(package-process-define-package): Mark it obsolete if older than the
builtin version.
(package-handle-response): Use line-end-position.
(package-read-archive-contents, package--download-one-archive):
Simplify.
(package--add-to-archive-contents): Skip if older than the builtin or
installed version.
(package-menu-describe-package): Fix last change.
(package-list-unversioned): New var.
(package-menu--generate): Use it.
* emacs-lisp/autoload.el: Manage package--builtin-versions.
(autoload--insert-text, autoload--insert-cookie-text): New functions.
(autoload-builtin-package-versions): New variable.
(autoload-generate-file-autoloads): Use them.
Remove the list of autoloaded functions/macros from the
(autoload...) comments.
* Makefile.in (autoloads): Set autoload-builtin-package-versions.
2013-06-15 Eli Zaretskii <eliz@gnu.org>
* simple.el (line-move-partial): Don't jump to the next screen

5
lisp/Makefile.in
View file

@ -178,7 +178,10 @@ autoloads: $(LOADDEFS) doit
cd $(lisp) && chmod +w $(AUTOGEN_VCS)
cd $(lisp); $(setwins_almost); \
echo Directories: $$wins; \
$(emacs) -l autoload --eval '(setq generated-autoload-file (unmsys--file-name "$(lisp)/loaddefs.el"))' -f batch-update-autoloads $$wins
$(emacs) -l autoload \
--eval '(setq autoload-builtin-package-versions t)' \
--eval '(setq generated-autoload-file (unmsys--file-name "$(lisp)/loaddefs.el"))' \
-f batch-update-autoloads $$wins
# This is required by the bootstrap-emacs target in ../src/Makefile, so
# we know that if we have an emacs executable, we also have a subdirs.el.

134
lisp/emacs-lisp/autoload.el
View file

@ -31,6 +31,7 @@
;;; Code:
(require 'lisp-mode) ;for `doc-string-elt' properties.
(require 'lisp-mnt)
(require 'help-fns) ;for help-add-fundoc-usage.
(eval-when-compile (require 'cl-lib))
@ -435,6 +436,64 @@ Return non-nil in the case where no autoloads were added at point."
(defvar print-readably)
(defun autoload--insert-text (output-start otherbuf outbuf absfile
load-name printfun)
;; If not done yet, figure out where to insert this text.
(unless (marker-buffer output-start)
(let ((outbuf
(or (if otherbuf
;; A file-local setting of
;; autoload-generated-file says we
;; should ignore OUTBUF.
nil
outbuf)
(autoload-find-destination absfile load-name)
;; The file has autoload cookies, but they're
;; already up-to-date. If OUTFILE is nil, the
;; entries are in the expected OUTBUF,
;; otherwise they're elsewhere.
(throw 'done otherbuf))))
(with-current-buffer outbuf
(move-marker output-start (point) outbuf))))
(let ((standard-output (marker-buffer output-start)))
(funcall printfun)))
(defun autoload--insert-cookie-text (output-start otherbuf outbuf absfile
load-name file)
(autoload--insert-text
output-start otherbuf outbuf absfile load-name
(lambda ()
(search-forward generate-autoload-cookie)
(skip-chars-forward " \t")
(if (eolp)
(condition-case-unless-debug err
;; Read the next form and make an autoload.
(let* ((form (prog1 (read (current-buffer))
(or (bolp) (forward-line 1))))
(autoload (make-autoload form load-name)))
(if autoload
nil
(setq autoload form))
(let ((autoload-print-form-outbuf
standard-output))
(autoload-print-form autoload)))
(error
(message "Autoload cookie error in %s:%s %S"
file (count-lines (point-min) (point)) err)))
;; Copy the rest of the line to the output.
(princ (buffer-substring
(progn
;; Back up over whitespace, to preserve it.
(skip-chars-backward " \f\t")
(if (= (char-after (1+ (point))) ? )
;; Eat one space.
(forward-char 1))
(point))
(progn (forward-line 1) (point))))))))
(defvar autoload-builtin-package-versions nil)
;; When called from `generate-file-autoloads' we should ignore
;; `generated-autoload-file' altogether. When called from
;; `update-file-autoloads' we don't know `outbuf'. And when called from
@ -456,8 +515,7 @@ different from OUTFILE, then OUTBUF is ignored.
Return non-nil if and only if FILE adds no autoloads to OUTFILE
\(or OUTBUF if OUTFILE is nil)."
(catch 'done
(let ((autoloads-done '())
load-name
(let (load-name
(print-length nil)
(print-level nil)
(print-readably t) ; This does something in Lucid Emacs.
@ -466,7 +524,7 @@ Return non-nil if and only if FILE adds no autoloads to OUTFILE
(otherbuf nil)
(absfile (expand-file-name file))
;; nil until we found a cookie.
output-start ostart)
output-start)
(with-current-buffer (or visited
;; It is faster to avoid visiting the file.
(autoload-find-file file))
@ -487,58 +545,31 @@ Return non-nil if and only if FILE adds no autoloads to OUTFILE
(save-excursion
(save-restriction
(widen)
(when autoload-builtin-package-versions
(let ((version (lm-header "version"))
package)
(and version
(setq version (ignore-errors (version-to-list version)))
(setq package (or (lm-header "package")
(file-name-sans-extension
(file-name-nondirectory file))))
(setq output-start (make-marker))
(autoload--insert-text
output-start otherbuf outbuf absfile load-name
(lambda ()
(princ `(push (purecopy
',(cons (intern package) version))
package--builtin-versions))
(newline))))))
(goto-char (point-min))
(while (not (eobp))
(skip-chars-forward " \t\n\f")
(cond
((looking-at (regexp-quote generate-autoload-cookie))
;; If not done yet, figure out where to insert this text.
(unless output-start
(let ((outbuf
(or (if otherbuf
;; A file-local setting of
;; autoload-generated-file says we
;; should ignore OUTBUF.
nil
outbuf)
(autoload-find-destination absfile load-name)
;; The file has autoload cookies, but they're
;; already up-to-date. If OUTFILE is nil, the
;; entries are in the expected OUTBUF,
;; otherwise they're elsewhere.
(throw 'done otherbuf))))
(with-current-buffer outbuf
(setq output-start (point-marker)
ostart (point)))))
(search-forward generate-autoload-cookie)
(skip-chars-forward " \t")
(if (eolp)
(condition-case-unless-debug err
;; Read the next form and make an autoload.
(let* ((form (prog1 (read (current-buffer))
(or (bolp) (forward-line 1))))
(autoload (make-autoload form load-name)))
(if autoload
(push (nth 1 form) autoloads-done)
(setq autoload form))
(let ((autoload-print-form-outbuf
(marker-buffer output-start)))
(autoload-print-form autoload)))
(error
(message "Autoload cookie error in %s:%s %S"
file (count-lines (point-min) (point)) err)))
;; Copy the rest of the line to the output.
(princ (buffer-substring
(progn
;; Back up over whitespace, to preserve it.
(skip-chars-backward " \f\t")
(if (= (char-after (1+ (point))) ? )
;; Eat one space.
(forward-char 1))
(point))
(progn (forward-line 1) (point)))
(marker-buffer output-start))))
(unless output-start (setq output-start (make-marker)))
(autoload--insert-cookie-text
output-start otherbuf outbuf absfile load-name file))
((looking-at ";")
;; Don't read the comment.
(forward-line 1))
@ -553,12 +584,11 @@ Return non-nil if and only if FILE adds no autoloads to OUTFILE
(save-excursion
;; Insert the section-header line which lists the file name
;; and which functions are in it, etc.
(cl-assert (= ostart output-start))
(goto-char output-start)
(let ((relfile (file-relative-name absfile)))
(autoload-insert-section-header
(marker-buffer output-start)
autoloads-done load-name relfile
() load-name relfile
(if secondary-autoloads-file-buf
;; MD5 checksums are much better because they do not
;; change unless the file changes (so they'll be

7
lisp/emacs-lisp/cl-lib.el
View file

@ -36,13 +36,6 @@
;; package which should always be present.
;;; Future notes:
;; Once Emacs 19 becomes standard, many things in this package which are
;; messy for reasons of compatibility can be greatly simplified. For now,
;; I prefer to maintain one unified version.
;;; Change Log:
;; Version 2.02 (30 Jul 93):

131
lisp/emacs-lisp/package.el
View file

@ -140,7 +140,6 @@
;; installing it
;; - Interface with desktop.el so that restarting after an install
;; works properly
;; - Implement M-x package-upgrade, to upgrade any/all existing packages
;; - 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
@ -159,14 +158,7 @@
;; - 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? [ maybe there's no point ]
;; - 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
;; - perhaps have an "unstable" tree in ELPA as well as a stable one
;;; Code:
@ -201,7 +193,7 @@ versions of all packages not specified by other elements.
For an element (NAME VERSION), NAME is a package name (a symbol).
VERSION should be t, a string, or nil.
If VERSION is t, all versions are loaded, though obsolete ones
will be put in `package-obsolete-alist' and not activated.
will be put in `package-obsolete-list' and not activated.
If VERSION is a string, only that version is ever loaded.
Any other version, even if newer, is silently ignored.
Hence, the package is \"held\" at that version.
@ -265,7 +257,7 @@ Lower version numbers than this will probably be understood as well.")
(defvar package-archive-contents nil
"Cache of the contents of the Emacs Lisp Package Archive.
This is an alist mapping package names (symbols) to
`package--desc' structures.")
`package-desc' structures.")
(put 'package-archive-contents 'risky-local-variable t)
(defcustom package-user-dir (locate-user-emacs-file "elpa")
@ -361,8 +353,6 @@ package came.
reqs
summary)
;; The value is precomputed in finder-inf.el, but don't load that
;; until it's needed (i.e. when `package-initialize' is called).
(defvar package--builtins nil
"Alist of built-in packages.
The actual value is initialized by loading the library
@ -384,17 +374,14 @@ loaded and/or activated, customize `package-load-list'.")
(put 'package-alist 'risky-local-variable t)
(defvar package-activated-list nil
;; FIXME: This should implicitly include all builtin packages.
"List of the names of currently activated packages.")
(put 'package-activated-list 'risky-local-variable t)
(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.
Each element of the list is (NAME . VERSION-ALIST), where each
entry in VERSION-ALIST is (VERSION-LIST . PACKAGE-DESC).")
(put 'package-obsolete-alist 'risky-local-variable t)
(defvar package-obsolete-list nil
"List of obsolete packages.
Each element of the list is a `package-desc'.")
(put 'package-obsolete-list 'risky-local-variable t)
(defun package-version-join (vlist)
"Return the version string corresponding to the list VLIST.
@ -425,12 +412,6 @@ This is, approximately, the inverse of `version-to-list'.
(pop str-list))
(apply 'concat (nreverse str-list)))))
(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 (concat "\\`" package-subdirectory-regexp "\\'") dirname)
(match-string 1 dirname)))
(defun package-load-descriptor (pkg-dir)
"Load the description file in directory PKG-DIR."
(let ((pkg-file (expand-file-name (package--description-file pkg-dir)
@ -452,7 +433,7 @@ controls which package subdirectories may be loaded.
In each valid package subdirectory, this function loads the
description file containing a call to `define-package', which
updates `package-alist' and `package-obsolete-alist'."
updates `package-alist' and `package-obsolete-list'."
(dolist (dir (cons package-user-dir package-directory-list))
(when (file-directory-p dir)
(dolist (subdir (directory-files dir))
@ -498,12 +479,13 @@ Return the max version (as a string) if the package is held at a lower version."
"Return true if PACKAGE is built-in to Emacs.
Optional arg MIN-VERSION, if non-nil, should be a version list
specifying the minimum acceptable version."
(require 'finder-inf nil t) ; For `package--builtins'.
(if (eq package 'emacs)
(version-list-<= min-version (version-to-list emacs-version))
(let ((elt (assq package package--builtins)))
(and elt (version-list-<= min-version
(package--bi-desc-version (cdr elt)))))))
(let ((bi (assq package package--builtin-versions)))
(cond
(bi (version-list-<= min-version (cdr bi)))
(min-version nil)
(t
(require 'finder-inf nil t) ; For `package--builtins'.
(assq package package--builtins)))))
(defun package--from-builtin (bi-desc)
(package-desc-create :name (pop bi-desc)
@ -550,17 +532,7 @@ Required package `%s-%s' is unavailable"
(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 (package-desc-version pkg-vec) (cdr elt))
(setcdr elt (cons (cons (package-desc-version pkg-vec) pkg-vec)
(cdr elt))))
;; Make a new association.
(push (cons package (list (cons (package-desc-version pkg-vec)
pkg-vec)))
package-obsolete-alist))))
(push pkg-vec package-obsolete-list))
(defun define-package (name-string version-string
&optional docstring requirements
@ -585,6 +557,10 @@ EXTRA-PROPERTIES is currently unused."
(version (package-desc-version new-pkg-desc))
(old-pkg (assq name package-alist)))
(cond
;; If it's not newer than a builtin version, mark it obsolete.
((let ((bi (assq name package--builtin-versions)))
(and bi (version-list-<= version (cdr bi))))
(package-mark-obsolete name new-pkg-desc))
;; If there's no old package, just add this to `package-alist'.
((null old-pkg)
(push (cons name new-pkg-desc) package-alist))
@ -762,9 +738,7 @@ It will move point to somewhere in the headers."
(let ((response (url-http-parse-response)))
(when (or (< response 200) (>= response 300))
(error "Error during download request:%s"
(buffer-substring-no-properties (point) (progn
(end-of-line)
(point)))))))
(buffer-substring-no-properties (point) (line-end-position))))))
(defun package-download-single (name version desc requires)
"Download and install a single-file package."
@ -813,6 +787,7 @@ not included in this list."
;; A package is required, but not installed. It might also be
;; blocked via `package-load-list'.
(let ((pkg-desc (cdr (assq next-pkg package-archive-contents)))
;; FIXME: package-disabled-p needs to use a <= test!
(disabled (package-disabled-p next-pkg next-version)))
(when disabled
(if (stringp disabled)
@ -882,10 +857,9 @@ If successful, set the variable `package-archive-contents'.
If the archive version is too new, signal an error."
;; Version 1 of 'archive-contents' is identical to our internal
;; representation.
(let* ((dir (concat "archives/" archive))
(contents-file (concat dir "/archive-contents"))
contents)
(when (setq contents (package--read-archive-file contents-file))
(let* ((contents-file (format "archives/%s/archive-contents" archive))
(contents (package--read-archive-file contents-file)))
(when contents
(dolist (package contents)
(package--add-to-archive-contents package archive)))))
@ -903,10 +877,11 @@ If the archive version is too new, signal an error."
PACKAGE should have the form (NAME . PACKAGE--AC-DESC).
Also, add the originating archive to the `package-desc' structure."
(let* ((name (car package))
(version (package--ac-desc-version (cdr package)))
(pkg-desc
(package-desc-create
:name name
:version (package--ac-desc-version (cdr package))
:version version
:reqs (package--ac-desc-reqs (cdr package))
:summary (package--ac-desc-summary (cdr package))
:kind (package--ac-desc-kind (cdr package))
@ -914,19 +889,25 @@ Also, add the originating archive to the `package-desc' structure."
(entry (cons name pkg-desc))
(existing-package (assq name package-archive-contents))
(pinned-to-archive (assoc name package-pinned-packages)))
(cond ((and pinned-to-archive
;; If pinned to another archive, skip entirely.
(not (equal (cdr pinned-to-archive) archive)))
nil)
((not existing-package)
(push entry package-archive-contents))
((version-list-< (package-desc-version (cdr existing-package))
(package-desc-version pkg-desc))
;; Replace the entry with this one.
(setq package-archive-contents
(cons entry
(delq existing-package
package-archive-contents)))))))
(cond
;; Skip entirely if pinned to another archive or if no more recent
;; than what we already have installed.
((or (and pinned-to-archive
(not (equal (cdr pinned-to-archive) archive)))
(let ((bi (assq name package--builtin-versions)))
(and bi (version-list-<= version (cdr bi))))
(let ((ins (cdr (assq name package-alist))))
(and ins (version-list-<= version (package-desc-version ins)))))
nil)
((not existing-package)
(push entry package-archive-contents))
((version-list-< (package-desc-version (cdr existing-package))
version)
;; Replace the entry with this one.
(setq package-archive-contents
(cons entry
(delq existing-package
package-archive-contents)))))))
(defun package-download-transaction (package-list)
"Download and install all the packages in PACKAGE-LIST.
@ -1123,8 +1104,8 @@ The file can either be a tar file or an Emacs Lisp file."
ARCHIVE should be a cons cell of the form (NAME . LOCATION),
similar to an entry in `package-alist'. Save the cached copy to
\"archives/NAME/archive-contents\" in `package-user-dir'."
(let* ((dir (expand-file-name "archives" package-user-dir))
(dir (expand-file-name (car archive) dir)))
(let* ((dir (expand-file-name (format "archives/%s" (car archive))
package-user-dir)))
(package--with-work-buffer (cdr archive) file
;; Read the retrieved buffer to make sure it is valid (e.g. it
;; may fetch a URL redirect page).
@ -1156,7 +1137,7 @@ The variable `package-load-list' controls which packages to load.
If optional arg NO-ACTIVATE is non-nil, don't activate packages."
(interactive)
(setq package-alist nil
package-obsolete-alist nil)
package-obsolete-list nil)
(package-load-all-descriptors)
(package-read-all-archive-contents)
(unless no-activate
@ -1421,6 +1402,9 @@ package PKG-DESC, add one. The alist is keyed with PKG-DESC."
;; FIXME: Should we move status into pkg-desc?
(push (cons ,pkg-desc ,status) ,listname)))
(defvar package-list-unversioned nil
"If non-nil include packages that don't have a version in `list-package'.")
(defun package-menu--generate (remember-pos packages)
"Populate the Package Menu.
If REMEMBER-POS is non-nil, keep point on the same entry.
@ -1441,6 +1425,8 @@ or a list of package names (symbols) to display."
(dolist (elt package--builtins)
(setq name (car elt))
(when (and (not (eq name 'emacs)) ; Hide the `emacs' package.
(or package-list-unversioned
(package--bi-desc-version (cdr elt)))
(or (eq packages t) (memq name packages)))
(package--push (package--from-builtin elt) "built-in" info-list)))
@ -1457,10 +1443,9 @@ or a list of package names (symbols) to display."
info-list))))
;; Obsolete packages:
(dolist (elt package-obsolete-alist)
(dolist (inner-elt (cdr elt))
(when (or (eq packages t) (memq (car elt) packages))
(package--push (cdr inner-elt) "obsolete" info-list))))
(dolist (elt package-obsolete-list)
(when (or (eq packages t) (memq (package-desc-full-name elt) packages))
(package--push elt "obsolete" info-list)))
;; Print the result.
(setq tabulated-list-entries (mapcar 'package-menu--print-info info-list))
@ -1508,7 +1493,7 @@ This fetches the contents of each archive specified in
If optional arg BUTTON is non-nil, describe its associated package."
(interactive)
(let ((pkg-desc (if button (button-get button 'package-desc)
(car (tabulated-list-get-id)))))
(tabulated-list-get-id))))
(if pkg-desc
;; FIXME: We could actually describe this particular pkg-desc.
(describe-package (package-desc-name pkg-desc)))))

3
lisp/finder.el
View file

@ -232,6 +232,9 @@ from; the default is `load-path'."
(insert (autoload-rubric generated-finder-keywords-file
"keyword-to-package mapping" t))
(search-backward " ")
;; FIXME: Now that we have package--builtin-versions, package--builtins is
;; only needed to get the list of unversioned packages and to get the
;; summary description of each package.
(insert "(setq package--builtins '(\n")
(dolist (package package--builtins)
(insert " ")

17
lisp/startup.el
View file

@ -413,19 +413,18 @@ Warning Warning!!! Pure space overflow !!!Warning Warning
:type 'directory
:initialize 'custom-initialize-delay)
(defconst package-subdirectory-regexp
"\\([^.].*?\\)-\\([0-9]+\\(?:[.][0-9]+\\|\\(?:pre\\|beta\\|alpha\\)[0-9]+\\)*\\)"
"Regular expression matching the name of a package subdirectory.
The first subexpression is the package name.
The second subexpression is the version string.
The regexp should not contain a starting \"\\`\" or a trailing
\"\\'\"; those are added automatically by callers.")
(defvar package--builtin-versions
;; Mostly populated by loaddefs.el via autoload-builtin-package-versions.
(purecopy `((emacs . ,(version-to-list emacs-version))))
"Alist giving the version of each versioned builtin package.
I.e. each element of the list is of the form (NAME . VERSION) where
NAME is the package name as a symbol, and VERSION is its version
as a list.")
(defun package--description-file (dir)
(concat (let ((subdir (file-name-nondirectory
(directory-file-name dir))))
(if (string-match package-subdirectory-regexp subdir)
(if (string-match "\\([^.].*?\\)-\\([0-9]+\\(?:[.][0-9]+\\|\\(?:pre\\|beta\\|alpha\\)[0-9]+\\)*\\)" subdir)
(match-string 1 subdir) subdir))
"-pkg.el"))