From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Stefan Monnier Newsgroups: gmane.emacs.devel Subject: Re: cl-defstruct-based package.el, now with ert tests and no external tar! Date: Fri, 21 Jun 2013 00:20:58 -0400 Message-ID: References: <87y5cx0wh7.fsf@yandex.ru> <87ppy7e5ke.fsf@lifelogs.com> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: ger.gmane.org 1371788468 8089 80.91.229.3 (21 Jun 2013 04:21:08 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Fri, 21 Jun 2013 04:21:08 +0000 (UTC) Cc: Emacs development discussions To: Daniel Hackney Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Fri Jun 21 06:21:08 2013 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1UpsqR-0005jZ-9s for ged-emacs-devel@m.gmane.org; Fri, 21 Jun 2013 06:21:07 +0200 Original-Received: from localhost ([::1]:55734 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UpsqQ-0003pz-Ph for ged-emacs-devel@m.gmane.org; Fri, 21 Jun 2013 00:21:06 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:43087) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UpsqM-0003nL-GS for emacs-devel@gnu.org; Fri, 21 Jun 2013 00:21:04 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1UpsqK-0005w4-Rm for emacs-devel@gnu.org; Fri, 21 Jun 2013 00:21:02 -0400 Original-Received: from ironport2-out.teksavvy.com ([206.248.154.182]:65101) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UpsqK-0005vz-GA for emacs-devel@gnu.org; Fri, 21 Jun 2013 00:21:00 -0400 X-IronPort-Anti-Spam-Filtered: true X-IronPort-Anti-Spam-Result: Av8EABK/CFFFpZVy/2dsb2JhbABEuzWDWRdzgh4BAQQBViMFCwsOJhIUGA0kiB4GwS2NLINeA5JbA5IcgV6DE4FM X-IPAS-Result: Av8EABK/CFFFpZVy/2dsb2JhbABEuzWDWRdzgh4BAQQBViMFCwsOJhIUGA0kiB4GwS2NLINeA5JbA5IcgV6DE4FM X-IronPort-AV: E=Sophos;i="4.84,565,1355115600"; d="scan'208";a="16844540" Original-Received: from 69-165-149-114.dsl.teksavvy.com (HELO pastel.home) ([69.165.149.114]) by ironport2-out.teksavvy.com with ESMTP/TLS/ADH-AES256-SHA; 21 Jun 2013 00:20:54 -0400 Original-Received: by pastel.home (Postfix, from userid 20848) id 0A491631E8; Fri, 21 Jun 2013 00:20:59 -0400 (EDT) In-Reply-To: (Stefan Monnier's message of "Tue, 11 Jun 2013 22:18:20 -0400") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.3.50 (gnu/linux) X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 206.248.154.182 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:160796 Archived-At: > I installed a patch which includes a part of your patch. The last patch I installed includes further parts of your patch, tho heavily reworked. I think overall, this integrates most, if not all of your changes. Trying to merge your patch with the current tip gives me a "residue" of the following (fully untested, most probably broken) patch, FWIW. Stefan Using changes with id "33". Message: package.el patch from Hackney M lisp/emacs-lisp/package.el === modified file 'lisp/emacs-lisp/package.el' --- a/lisp/emacs-lisp/package.el 2013-06-21 04:19:53 +0000 +++ b/lisp/emacs-lisp/package.el 2013-06-21 04:20:02 +0000 @@ -418,6 +418,12 @@ (pop str-list)) (apply 'concat (nreverse str-list))))) +(defun package-desc-install-dir (desc) + "Return the install directory of DESC." + (file-name-as-directory + (expand-file-name (package-desc-full-name desc) + package-user-dir))) + (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) @@ -586,27 +592,26 @@ ;; From Emacs 22, but changed so it adds to load-path. (defun package-autoload-ensure-default-file (file) "Make sure that the autoload file FILE exists and if not create it." - (unless (file-exists-p file) - (write-region - (concat ";;; " (file-name-nondirectory file) - " --- automatically extracted autoloads\n" - ";;\n" - ";;; Code:\n" - "(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))\n" - " \n;; Local Variables:\n" - ";; version-control: never\n" - ";; no-byte-compile: t\n" - ";; no-update-autoloads: t\n" - ";; End:\n" - ";;; " (file-name-nondirectory file) - " ends here\n") - nil file)) - file) + (write-region + (concat ";;; " (file-name-nondirectory file) + " --- automatically extracted autoloads\n" + ";;\n" + ";;; Code:\n" + "(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))\n" + " \n;; Local Variables:\n" + ";; version-control: never\n" + ";; no-byte-compile: t\n" + ";; no-update-autoloads: t\n" + ";; End:\n" + ";;; " (file-name-nondirectory file) + " ends here\n") + nil file)) -(defun package-generate-autoloads (name pkg-dir) - (require 'autoload) ;Load before we let-bind generated-autoload-file! - (let* ((auto-name (format "%s-autoloads.el" name)) - ;;(ignore-name (concat name "-pkg.el")) +(defun package-generate-autoloads (desc) + "Generate autoloads for package DESC." + (require 'autoload) ;; Load before we let-bind generated-autoload-file! + (let* ((auto-name (format "%s-autoloads.el" (package-desc-name desc))) + (pkg-dir (package-desc-install-dir desc)) (generated-autoload-file (expand-file-name auto-name pkg-dir)) (version-control 'never)) (package-autoload-ensure-default-file generated-autoload-file) @@ -621,10 +626,8 @@ (declare-function tar-header-link-type "tar-mode" (tar-header) t) (defun package-untar-buffer (dir) - "Untar the current buffer. -This uses `tar-untar-buffer' from Tar mode. All files should -untar into a directory named DIR; otherwise, signal an error." - (require 'tar-mode) + "Untar the current buffer into DIR. +This uses `tar-untar-buffer' from Tar mode." (tar-mode) ;; Make sure everything extracts into DIR. (let ((regexp (concat "\\`" (regexp-quote (expand-file-name dir)) "/")) @@ -764,16 +767,15 @@ (defvar package--initialized nil) -(defun package-installed-p (package &optional min-version) - "Return true if PACKAGE, of MIN-VERSION or newer, is installed. -MIN-VERSION should be a version list." - (unless package--initialized (error "package.el is not yet initialized!")) - (let ((pkg-desc (assq package package-alist))) +(defun package-installed-p (name &optional min-version) + "Return true if NAME, of MIN-VERSION or newer, is installed. +NAME must be a symbol and MIN-VERSION must be a version list." + (let ((pkg-desc (assq name package-alist))) (if pkg-desc (version-list-<= min-version (package-desc-version (cdr pkg-desc))) ;; Also check built-in packages. - (package-built-in-p package min-version)))) + (package-built-in-p name min-version)))) (defun package-compute-transaction (package-list requirements) "Return a list of packages to be installed, including PACKAGE-LIST. @@ -863,8 +865,6 @@ "Re-read archive contents for ARCHIVE. 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* ((contents-file (format "archives/%s/archive-contents" archive)) (contents (package--read-archive-file contents-file))) (when contents @@ -917,7 +917,7 @@ (delq existing-package package-archive-contents))))))) -(defun package-download-transaction (package-list) +(defun package-install-transaction (package-list) "Download and install all the packages in PACKAGE-LIST. PACKAGE-LIST should be a list of package names (symbols). This function assumes that all package requirements in @@ -953,7 +953,9 @@ (error "Package `%s' is not available for installation" name)) (list pkg-desc)))) - (package-download-transaction + (unless package--initialized + (package-initialize t)) + (package-install-transaction ;; FIXME: Use (list pkg-desc) instead of just the name. (package-compute-transaction (list (package-desc-name pkg-desc)) (package-desc-reqs pkg-desc)))) @@ -980,9 +982,9 @@ (unless (re-search-forward "^;;; \\([^ ]*\\)\\.el ---[ \t]*\\(.*?\\)[ \t]*\\(-\\*-.*-\\*-[ \t]*\\)?$" nil t) (error "Packages lacks a file header")) (let ((file-name (match-string-no-properties 1)) - (desc (match-string-no-properties 2)) - (start (line-beginning-position))) - (unless (search-forward (concat ";;; " file-name ".el ends here")) + (summary (match-string-no-properties 2)) + (start (line-beginning-position))) + (unless (search-forward (format ";;; %s.el ends here" file-name)) (error "Package lacks a terminating comment")) ;; Try to include a trailing newline. (forward-line) @@ -999,8 +1001,8 @@ (error "Package lacks a \"Version\" or \"Package-Version\" header")) (package-desc-from-define - file-name pkg-version desc - (if requires-str (package-read-from-string requires-str)) + file-name pkg-version summary + (package-read-from-string requirements) :kind 'single)))) (defun package-tar-file-info () @@ -1057,16 +1059,19 @@ (package-install-from-buffer))) (defun package-delete (pkg-desc) - (let ((dir (package-desc-dir pkg-desc))) - (if (string-equal (file-name-directory dir) - (file-name-as-directory - (expand-file-name package-user-dir))) - (progn - (delete-directory dir t t) - (message "Package `%s' deleted." (package-desc-full-name pkg-desc))) + (let ((dir (package-desc-dir pkg-desc)) + (full-name (package-desc-full-name pkg-desc))) + (cond + ((not (stringp dir)) + (message "Package `%s' already deleted." full-name)) + ((string-equal (file-name-directory dir) + (file-name-as-directory + (expand-file-name package-user-dir))) + (delete-directory dir t t) + (message "Package `%s' deleted." full-name)) + (t ;; Don't delete "system" packages - (error "Package `%s' is a system package, not deleting" - (package-desc-full-name pkg-desc))))) + (error "Package `%s' is a system package, not deleting" full-name)))) (defun package-archive-base (desc) "Return the archive containing the package NAME." @@ -1230,7 +1235,7 @@ (dolist (req reqs) (setq name (car req) vers (cadr req) - text (format "%s-%s" (symbol-name name) + text (format "%s-%s" name (package-version-join vers))) (cond (first (setq first nil)) ((>= (+ 2 (current-column) (length text)) @@ -1526,7 +1531,7 @@ (let (installed available upgrades) ;; Build list of installed/available packages in this buffer. (dolist (entry tabulated-list-entries) - ;; ENTRY is (PKG-DESC [NAME VERSION STATUS DOC]) + ;; ENTRY is (PKG-DESC [NAME VERSION-STRING STATUS DOC]) (let ((pkg-desc (car entry)) (status (aref (cadr entry) 2))) (cond ((equal status "installed") @@ -1621,12 +1626,10 @@ (package-delete elt) (error (message (cadr err))))) (error "Aborted"))) - ;; If we deleted anything, regenerate `package-alist'. This is done - ;; automatically if we installed a package. - (and delete-list (null install-list) - (package-initialize)) (if (or delete-list install-list) - (package-menu--generate t t) + (progn + (package-initialize) + (package-menu--generate t t)) (message "No operations specified.")))) (defun package-menu--version-predicate (A B) @@ -1698,15 +1701,16 @@ (package-menu--generate nil t)) ;; The package menu buffer has keybindings. If the user types ;; `M-x list-packages', that suggests it should become current. - (switch-to-buffer buf)) + (switch-to-buffer buf) - (let ((upgrades (package-menu--find-upgrades))) - (if upgrades - (message "%d package%s can be upgraded; type `%s' to mark %s for upgrading." - (length upgrades) - (if (= (length upgrades) 1) "" "s") - (substitute-command-keys "\\[package-menu-mark-upgrades]") - (if (= (length upgrades) 1) "it" "them")))))) + (let ((upgrades (package-menu--find-upgrades))) + (if upgrades + (message "%d package%s can be upgraded; type `%s' to mark %s for upgrading." + (length upgrades) + (if (= (length upgrades) 1) "" "s") + (substitute-command-keys "\\[package-menu-mark-upgrades]") + (if (= (length upgrades) 1) "it" "them")))) + buf))) ;;;###autoload (defalias 'package-list-packages 'list-packages)