From e602e79c00f2c4515c31b3f4ae744e63b7192174 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Mon, 18 Dec 2023 13:27:39 +0100 Subject: [PATCH] Declare lexical-binding in -pkg.el files Running package-install emits a 'has no lexical-binding directive' warning for generated -pkg.el files. * lisp/emacs-lisp/package.el: (package--with-response-buffer-1): Remove redundant requires and function declarations. (package): Add to tools :group as per Keywords header. Bump :version accordingly. (package-vc-p): Remove redundant inline-letevals. (package--unquote): New convenience function. (package-desc-from-define, package-desc-suffix): Use it. (package-desc): Add individual :type and :documentation options to slots. Document dir and vc kinds. (package--alist-to-plist-args): Replace nconc+mapcar with mapcan. (package--write-description-file): New function extracted from package-generate-description-file. Specify lexical-binding to avoid package-install warnings (bug#67916). Stricter calls to prin1 and replace-regexp-in-string with overriding arguments. Use macroexp-quote. (package-generate-description-file): Refactor in terms of package--write-description-file. * lisp/emacs-lisp/package-vc.el: Add development and vc Keywords. Remove redundant requires. (package-vc): Add to vc :group and bump :version accordingly. (package-vc--main-file): Simplify. (package-vc--generate-description-file): Simplify and refactor in terms of package--write-description-file. (package-vc--unpack): Use package-vc-p. --- lisp/emacs-lisp/package-vc.el | 78 +++++---------- lisp/emacs-lisp/package.el | 182 ++++++++++++++++------------------ 2 files changed, 110 insertions(+), 150 deletions(-) diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index bef498f997c..14f3dc859bf 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2022-2023 Free Software Foundation, Inc. ;; Author: Philip Kaludercic -;; Keywords: tools +;; Keywords: development, tools, vc ;; This file is part of GNU Emacs. @@ -44,20 +44,19 @@ ;;; Code: -(eval-when-compile (require 'rx)) (eval-when-compile (require 'map)) (eval-when-compile (require 'cl-lib)) (require 'package) (require 'lisp-mnt) (require 'vc) -(require 'seq) (defgroup package-vc nil "Manage packages from VC checkouts." :group 'package + :group 'vc :link '(custom-manual "(emacs) Fetching Package Sources") :prefix "package-vc-" - :version "29.1") + :version "30.1") (defconst package-vc--elpa-packages-version 1 "Version number of the package specification format understood by package-vc.") @@ -308,59 +307,32 @@ package-vc--main-file ;; try and find the closest match. (let ((distance most-positive-fixnum) (best nil)) (dolist (alt (directory-files directory t "\\.el\\'" t)) - (let ((sd (string-distance file alt))) - (when (and (not (string-match-p (rx (or (: "-autoloads.el") - (: "-pkg.el")) - eos) - alt)) - (< sd distance)) + (unless (or (string-suffix-p "-autoloads.el" alt) + (string-suffix-p "-pkg.el" alt)) + (let ((sd (string-distance file alt))) (when (< sd distance) - (setq distance (string-distance file alt) - best alt))))) + (setq distance sd best alt))))) best)))) (defun package-vc--generate-description-file (pkg-desc pkg-file) "Generate a package description file for PKG-DESC and write it to PKG-FILE." - (let ((name (package-desc-name pkg-desc))) - ;; Infer the subject if missing. - (unless (package-desc-summary pkg-desc) - (setf (package-desc-summary pkg-desc) - (let ((main-file (package-vc--main-file pkg-desc))) - (or (package-desc-summary pkg-desc) - (and-let* ((pkg (cadr (assq name package-archive-contents)))) - (package-desc-summary pkg)) - (and main-file (file-exists-p main-file) - (lm-summary main-file)) - package--default-summary)))) - (let ((print-level nil) - (print-quoted t) - (print-length nil)) - (write-region - (concat - ";;; Generated package description from " - (replace-regexp-in-string - "-pkg\\.el\\'" ".el" - (file-name-nondirectory pkg-file)) - " -*- no-byte-compile: t -*-\n" - (prin1-to-string - (nconc - (list 'define-package - (symbol-name name) - (package-vc--version pkg-desc) - (package-desc-summary pkg-desc) - (let ((requires (package-desc-reqs pkg-desc))) - (list 'quote - ;; Turn version lists into string form. - (mapcar - (lambda (elt) - (list (car elt) - (package-version-join (cadr elt)))) - requires)))) - (list :kind 'vc) - (package--alist-to-plist-args - (package-desc-extras pkg-desc)))) - "\n") - nil pkg-file nil 'silent)))) + ;; Infer the subject if missing. + (unless (package-desc-summary pkg-desc) + (setf (package-desc-summary pkg-desc) + (or (and-let* ((pkg (cadr (assq (package-desc-name pkg-desc) + package-archive-contents)))) + (package-desc-summary pkg)) + (and-let* ((main-file (package-vc--main-file pkg-desc)) + ((file-exists-p main-file))) + (lm-summary main-file)) + package--default-summary))) + (let ((name (symbol-name (package-desc-name pkg-desc))) + (ver (package-vc--version pkg-desc)) + (doc (package-desc-summary pkg-desc)) + (reqs (package-desc-reqs pkg-desc)) + (extras (package-desc-extras pkg-desc)) + (props '(:kind vc))) + (package--write-description-file pkg-file name ver doc reqs extras props))) (defcustom package-vc-allow-build-commands nil "Whether to run extra build commands when installing VC packages. @@ -674,7 +646,7 @@ package-vc--unpack how to fetch and build the package. See `package-vc--archive-spec-alists' for details. The optional argument REV specifies a specific revision to checkout. This overrides the `:branch' attribute in PKG-SPEC." - (unless (eq (package-desc-kind pkg-desc) 'vc) + (unless (package-vc-p pkg-desc) (let ((copy (copy-package-desc pkg-desc))) (setf (package-desc-kind copy) 'vc pkg-desc copy))) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index bed6e74c921..d1ff6e67a8a 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -144,20 +144,17 @@ ;;; Code: (require 'cl-lib) -(eval-when-compile (require 'subr-x)) (eval-when-compile (require 'epg)) ;For setf accessors. -(eval-when-compile (require 'inline)) ;For `define-inline' -(require 'seq) (require 'tabulated-list) -(require 'macroexp) (require 'url-handlers) (require 'browse-url) (defgroup package nil "Manager for Emacs Lisp packages." :group 'applications - :version "24.1") + :group 'tools + :version "30.1") ;;; Customization options @@ -325,9 +322,6 @@ package-directory-list :risky t :version "24.1") -(declare-function epg-find-configuration "epg-config" - (protocol &optional no-cache program-alist)) - (defcustom package-gnupghome-dir (expand-file-name "gnupg" package-user-dir) "Directory containing GnuPG keyring or nil. This variable specifies the GnuPG home directory used by package. @@ -457,14 +451,18 @@ package--default-summary (define-inline package-vc-p (pkg-desc) "Return non-nil if PKG-DESC is a VC package." - (inline-letevals (pkg-desc) - (inline-quote (eq (package-desc-kind ,pkg-desc) 'vc)))) + (inline-quote (eq (package-desc-kind ,pkg-desc) 'vc))) + +(define-inline package--unquote (arg) + "Return ARG without its surrounding `quote', if any." + (inline-letevals (arg) + (inline-quote (if (eq (car-safe ,arg) 'quote) (cadr ,arg) ,arg)))) (cl-defstruct (package-desc ;; Rename the default constructor from `make-package-desc'. (:constructor package-desc-create) ;; Has the same interface as the old `define-package', - ;; which is still used in the "foo-pkg.el" files. Extra + ;; which is still used in the "foo-pkg.el" files. Extra ;; options can be supported by adding additional keys. (:constructor package-desc-from-define @@ -472,15 +470,14 @@ package-vc-p &rest rest-plist &aux (name (intern name-string)) - (version (if (eq (car-safe version-string) 'vc) - (version-to-list (cdr version-string)) - (version-to-list version-string))) + (version (version-to-list + (if (eq (car-safe version-string) 'vc) + (cdr version-string) + version-string))) (reqs (mapcar (lambda (elt) (list (car elt) (version-to-list (cadr elt)))) - (if (eq 'quote (car requirements)) - (nth 1 requirements) - requirements))) + (package--unquote requirements))) (kind (plist-get rest-plist :kind)) (archive (plist-get rest-plist :archive)) (extras (let (alist) @@ -489,47 +486,42 @@ package-vc-p (let ((value (cadr rest-plist))) (when value (push (cons (car rest-plist) - (if (eq (car-safe value) 'quote) - (cadr value) - value)) + (package--unquote value)) alist)))) (setq rest-plist (cddr rest-plist))) alist))))) - "Structure containing information about an individual package. -Slots: - -`name' Name of the package, as a symbol. - -`version' Version of the package, as a version list. - -`summary' Short description of the package, typically taken from - the first line of the file. - -`reqs' Requirements of the package. A list of (PACKAGE - VERSION-LIST) naming the dependent package and the minimum - required version. - -`kind' The distribution format of the package. Currently, it is - either `single' or `tar'. - -`archive' The name of the archive (as a string) whence this - package came. - -`dir' The directory where the package is installed (if installed), - `builtin' if it is built-in, or nil otherwise. - -`extras' Optional alist of additional keyword-value pairs. - -`signed' Flag to indicate that the package is signed by provider." - name - version - (summary package--default-summary) - reqs - kind - archive - dir - extras - signed) + "Structure containing information about an individual package." + (name + nil :type symbol :documentation + "Name of the package.") + (version + () :type list :documentation + "Version of the package, as a version list.") + (summary + package--default-summary :type string :documentation + "Short description of the package, typically taken from the first +line of the file.") + (reqs + () :type list :documentation + "Requirements of the package. A list of (PACKAGE VERSION-LIST) +naming the dependent package and the minimum required version.") + (kind + nil :type symbol :documentation + "The distribution format of the package. Currently, it is one of +`single', `tar', `dir', or `vc'.") + (archive + nil :type string :documentation + "The name of the archive whence this package came.") + (dir + nil :type (or string symbol) :documentation + "The directory where the package is installed (if installed), +`builtin' if it is built-in, or nil otherwise." ) + (extras + () :type list :documentation + "Optional alist of additional keyword-value pairs.") + (signed + nil :type boolean :documentation + "Flag to indicate that the package is signed by provider.")) (defun package--from-builtin (bi-desc) "Create a `package-desc' object from BI-DESC. @@ -597,12 +589,9 @@ package-desc-suffix (defun package-desc--keywords (pkg-desc) "Return keywords of package-desc object PKG-DESC. These keywords come from the foo-pkg.el file, and in general -corresponds to the keywords in the \"Keywords\" header of the +correspond to the keywords in the \"Keywords\" header of the package." - (let ((keywords (cdr (assoc :keywords (package-desc-extras pkg-desc))))) - (if (eq (car-safe keywords) 'quote) - (nth 1 keywords) - keywords))) + (package--unquote (cdr (assq :keywords (package-desc-extras pkg-desc))))) (defun package-desc-priority (pkg-desc) "Return the priority of the archive of package-desc object PKG-DESC." @@ -978,8 +967,7 @@ package-untar-buffer (defun package--alist-to-plist-args (alist) (mapcar #'macroexp-quote - (apply #'nconc - (mapcar (lambda (pair) (list (car pair) (cdr pair))) alist)))) + (mapcan (lambda (pair) (list (car pair) (cdr pair))) alist))) (defun package-unpack (pkg-desc) "Install the contents of the current buffer as a package." @@ -1032,37 +1020,43 @@ package-unpack (package--reload-previously-loaded new-desc))) pkg-dir)) +;; Potentially also used in elpa.git. +(defun package--write-description-file ( file name version doc reqs extras + &optional extra-props verbose) + "Write a `define-package' declaration to FILE. +Absolute FILE names the -pkg.el description file. +NAME, VERSION, and DOC are the leading, and EXTRA-PROPS the +trailing, arguments of `define-package'. +REQS and EXTRAS are the eponymous `package-desc' slots. +Non-nil VERBOSE means display \"Wrote file\" message." + (let* ((src (replace-regexp-in-string (rx "-pkg.el" eos) ".el" + (file-name-nondirectory file) t t)) + (def `(define-package ,name ,version ,doc + ,(macroexp-quote + ;; Turn requirement version lists into string form. + (mapcar (lambda (elt) + (list (car elt) + (package-version-join (cadr elt)))) + reqs)) + ,@extra-props + ,@(package--alist-to-plist-args extras))) + (print-cfg '((length . nil) + (level . nil) + (quoted . t))) + (str (concat ";;; Generated package description from " src + " -*- no-byte-compile: t; lexical-binding: t -*-\n" + (prin1-to-string def nil print-cfg) + "\n"))) + (write-region str nil file nil (unless verbose 'silent)))) + (defun package-generate-description-file (pkg-desc pkg-file) "Create the foo-pkg.el file PKG-FILE for single-file package PKG-DESC." - (let* ((name (package-desc-name pkg-desc))) - (let ((print-level nil) - (print-quoted t) - (print-length nil)) - (write-region - (concat - ";;; Generated package description from " - (replace-regexp-in-string "-pkg\\.el\\'" ".el" - (file-name-nondirectory pkg-file)) - " -*- no-byte-compile: t -*-\n" - (prin1-to-string - (nconc - (list 'define-package - (symbol-name name) - (package-version-join (package-desc-version pkg-desc)) - (package-desc-summary pkg-desc) - (let ((requires (package-desc-reqs pkg-desc))) - (list 'quote - ;; Turn version lists into string form. - (mapcar - (lambda (elt) - (list (car elt) - (package-version-join (cadr elt)))) - requires)))) - (package--alist-to-plist-args - (package-desc-extras pkg-desc)))) - "\n") - nil pkg-file nil 'silent)))) - + (let ((name (symbol-name (package-desc-name pkg-desc))) + (ver (package-version-join (package-desc-version pkg-desc))) + (doc (package-desc-summary pkg-desc)) + (reqs (package-desc-reqs pkg-desc)) + (extras (package-desc-extras pkg-desc))) + (package--write-description-file pkg-file name ver doc reqs extras))) ;;;; Autoload (declare-function autoload-rubric "autoload" (file &optional type feature)) @@ -1311,11 +1305,6 @@ package--archive-file-exists-p (url-http-file-exists-p (concat location file))) (file-exists-p (expand-file-name file location))))) -(declare-function epg-make-context "epg" - (&optional protocol armor textmode include-certs - cipher-algorithm - digest-algorithm - compress-algorithm)) (declare-function epg-verify-string "epg" ( context signature &optional signed-text)) (declare-function epg-context-result-for "epg" (context name)) @@ -1397,7 +1386,6 @@ package--with-response-buffer-1 url (lambda (status) (let ((b (current-buffer))) - (require 'url-handlers) (package--unless-error body (when-let* ((er (plist-get status :error))) (error "Error retrieving: %s %S" url er)) -- 2.43.0