From f4ad42936e0b83caca91389a977d7258b69ed40a Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Thu, 30 Apr 2015 02:27:10 +0100 Subject: [PATCH] * lisp/emacs-lisp/package.el: Some speed optimizations on menu refresh (package-menu--print-info): Obsolete. (package-menu--print-info-simple): New function. (package-menu--refresh): Use it, simplify code, and improve performance. * lisp/emacs-lisp/tabulated-list.el (tabulated-list-print-entry): Tiny performance improvement. --- lisp/emacs-lisp/package.el | 64 +++++++++++++++++-------------- lisp/emacs-lisp/tabulated-list.el | 6 ++- 2 files changed, 39 insertions(+), 31 deletions(-) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index c3bec360faf..db61ababd6d 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2458,8 +2458,6 @@ of these dependencies, similar to the list returned by ((version-list-= version hv) "held") ((version-list-< version hv) "obsolete") (t "disabled")))) - ((package-built-in-p name version) "obsolete") - ((package--incompatible-p pkg-desc) "incompat") (dir ;One of the installed packages. (cond ((not (file-exists-p (package-desc-dir pkg-desc))) "deleted") @@ -2468,6 +2466,7 @@ of these dependencies, similar to the list returned by (if (package--user-selected-p name) "installed" "dependency"))) (t "obsolete"))) + ((package--incompatible-p pkg-desc) "incompat") (t (let* ((ins (cadr (assq name package-alist))) (ins-v (if ins (package-desc-version ins)))) @@ -2542,24 +2541,25 @@ PACKAGES should be nil or t, which means to display all known packages. KEYWORDS should be nil or a list of keywords." ;; Construct list of (PKG-DESC . STATUS). (unless packages (setq packages t)) - (let (info-list name) + (let (info-list) ;; Installed packages: (dolist (elt package-alist) - (setq name (car elt)) - (when (or (eq packages t) (memq name packages)) - (dolist (pkg (cdr elt)) - (when (package--has-keyword-p pkg keywords) - (package--push pkg (package-desc-status pkg) info-list))))) + (let ((name (car elt))) + (when (or (eq packages t) (memq name packages)) + (dolist (pkg (cdr elt)) + (when (package--has-keyword-p pkg keywords) + (push pkg info-list)))))) ;; Built-in packages: (dolist (elt package--builtins) - (setq name (car elt)) - (when (and (not (eq name 'emacs)) ; Hide the `emacs' package. - (package--has-keyword-p (package--from-builtin elt) keywords) - (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))) + (let ((pkg (package--from-builtin elt)) + (name (car elt))) + (when (not (eq name 'emacs)) ; Hide the `emacs' package. + (when (and (package--has-keyword-p pkg keywords) + (or package-list-unversioned + (package--bi-desc-version (cdr elt))) + (or (eq packages t) (memq name packages))) + (push pkg info-list))))) ;; Available and disabled packages: (dolist (elt package-archive-contents) @@ -2568,11 +2568,11 @@ KEYWORDS should be nil or a list of keywords." ;; Hide available-obsolete or low-priority packages. (dolist (pkg (package--remove-hidden (cdr elt))) (when (package--has-keyword-p pkg keywords) - (package--push pkg (package-desc-status pkg) info-list)))))) + (push pkg info-list)))))) ;; Print the result. (setq tabulated-list-entries - (mapcar #'package-menu--print-info info-list)))) + (mapcar #'package-menu--print-info-simple info-list)))) (defun package-all-keywords () "Collect all package keywords" @@ -2654,8 +2654,15 @@ shown." "Return a package entry suitable for `tabulated-list-entries'. PKG has the form (PKG-DESC . STATUS). Return (PKG-DESC [NAME VERSION STATUS DOC])." - (let* ((pkg-desc (car pkg)) - (status (cdr pkg)) + (package-menu--print-info-simple (car pkg))) +(make-obsolete 'package-menu--print-info + 'package-menu--print-info-simple "25.1") + +(defun package-menu--print-info-simple (pkg) + "Return a package entry suitable for `tabulated-list-entries'. +PKG is a package-desc object. +Return (PKG-DESC [NAME VERSION STATUS DOC])." + (let* ((status (package-desc-status pkg)) (face (pcase status (`"built-in" 'font-lock-builtin-face) (`"available" 'default) @@ -2668,21 +2675,20 @@ Return (PKG-DESC [NAME VERSION STATUS DOC])." (`"unsigned" 'font-lock-warning-face) (`"incompat" 'font-lock-comment-face) (_ 'font-lock-warning-face)))) ; obsolete. - (list pkg-desc - `[,(list (symbol-name (package-desc-name pkg-desc)) - 'face 'link - 'follow-link t - 'package-desc pkg-desc - 'action 'package-menu-describe-package) + (list pkg + `[(,(symbol-name (package-desc-name pkg)) + face link + follow-link t + package-desc ,pkg + action package-menu-describe-package) ,(propertize (package-version-join - (package-desc-version pkg-desc)) + (package-desc-version pkg)) 'font-lock-face face) ,(propertize status 'font-lock-face face) ,@(if (cdr package-archives) - (list (propertize (or (package-desc-archive pkg-desc) "") + (list (propertize (or (package-desc-archive pkg) "") 'font-lock-face face))) - ,(propertize (package-desc-summary pkg-desc) - 'font-lock-face face)]))) + ,(package-desc-summary pkg)]))) (defvar package-menu--old-archive-contents nil "`package-archive-contents' before the latest refresh.") diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index 15a0914cb17..b12edc8c595 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -341,8 +341,10 @@ of column descriptors." (dotimes (n ncols) (setq x (tabulated-list-print-col n (aref cols n) x))) (insert ?\n) - (put-text-property beg (point) 'tabulated-list-id id) - (put-text-property beg (point) 'tabulated-list-entry cols))) + ;; Ever so slightly faster than calling `put-text-property' twice. + (add-text-properties + beg (point) + `(tabulated-list-id ,id tabulated-list-entry ,cols)))) (defun tabulated-list-print-col (n col-desc x) "Insert a specified Tabulated List entry at point. -- 2.39.2