diff --git a/CHANGELOG.md b/CHANGELOG.md index 89446ac4..69a4a6b6 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -26,6 +26,7 @@ Check [Keep a Changelog](http://keepachangelog.com/) for recommendations on how * Add aliases for `pkg-file` command (0d35d762a12bd399657c2fdcb60541dcc0c8b5e0) * Add option to init from `Keg`-file (#182) * Add option to init from elisp source file (#183) +* Print archives progress (#184) ## 0.8.x > Released Mar 08, 2023 diff --git a/docs/content/en/Development-API/_index.md b/docs/content/en/Development-API/_index.md index f49b7f7f..f3206562 100644 --- a/docs/content/en/Development-API/_index.md +++ b/docs/content/en/Development-API/_index.md @@ -664,7 +664,7 @@ Define each log level color. ## 🔍 Macro: eask-with-verbosity (`symbol` &rest `body`) -Define executions with the verbosity level. +Define verbosity scope. ```elisp (eask-with-verbosity 'debug @@ -676,6 +676,23 @@ Everything in the scope of this macro will be muted unless the verbosity reaches. It will only be printed when you have specified `--verbose 4` global option. +## 🔍 Macro: eask-with-verbosity-override (`symbol` &rest `body`) + +Define override verbosity scope. + +```elisp +(eask-with-verbosity 'debug + (eask-with-verbosity-override 'log + ;; TODO: execution here.. + ) + (eask-with-verbosity-override 'info + ;; TODO: execution here.. + )) +``` + +Like macro `eask-with-verbosity`; but force display messages if it wasn't able +to display. + ## 🔍 Function: eask-debug (`msg` &rest `args`) ```elisp diff --git a/docs/content/zh-TW/Development-API/_index.md b/docs/content/zh-TW/Development-API/_index.md index 79e01392..baca4cab 100644 --- a/docs/content/zh-TW/Development-API/_index.md +++ b/docs/content/zh-TW/Development-API/_index.md @@ -656,7 +656,7 @@ $ cat /.log/messages.log ## 🔍 巨集: eask-with-verbosity (`symbol` &rest `body`) -使用詳細級別定義執行。 +定義消息範圍。 ```elisp (eask-with-verbosity 'debug @@ -667,6 +667,22 @@ $ cat /.log/messages.log 除非冗長,否則此宏範圍內的所有內容都將被靜音。 僅當您指定 `--verbose 4` 時才會打印 全局選項。 +## 🔍 巨集: eask-with-verbosity-override (`symbol` &rest `body`) + +定義覆蓋消息範圍。 + +```elisp +(eask-with-verbosity 'debug + (eask-with-verbosity-override 'log + ;; TODO: 在這裡執行.. + ) + (eask-with-verbosity-override 'info + ;; TODO: 在這裡執行.. + )) +``` + +就像宏 `eask-with-verbosity` 一樣;但如果無法顯示則強制顯示消息。 + ## 🔍 函式: eask-debug (`msg` &rest `args`) ```elisp diff --git a/lisp/_prepare.el b/lisp/_prepare.el index 5cde6ed5..2d7620f5 100644 --- a/lisp/_prepare.el +++ b/lisp/_prepare.el @@ -204,33 +204,156 @@ Argument BODY are forms for execution." (string-replace old new s) (replace-regexp-in-string (regexp-quote old) new s t t))) +;; +;;; Progress + +(defcustom eask-elapsed-time nil + "Log with elapsed time." + :type 'boolean + :group 'eask) + +(defcustom eask-minimum-reported-time 0.1 + "Minimal load time that will be reported." + :type 'number + :group 'eask) + +(defmacro eask-with-progress (msg-start body msg-end) + "Progress BODY wrapper with prefix (MSG-START) and suffix (MSG-END) messages." + (declare (indent 0) (debug t)) + `(if eask-elapsed-time + (let ((now (current-time))) + (ignore-errors (eask-write ,msg-start)) ,body + (let ((elapsed (float-time (time-subtract (current-time) now)))) + (if (< elapsed eask-minimum-reported-time) + (ignore-errors (eask-msg ,msg-end)) + (ignore-errors (eask-write ,msg-end)) + (eask-msg (ansi-white (format " (%.3fs)" elapsed)))))) + (ignore-errors (eask-write ,msg-start)) ,body + (ignore-errors (eask-msg ,msg-end)))) + +(defun eask-progress-seq (prefix sequence suffix func) + "Shorthand to progress SEQUENCE of task. + +Arguments PREFIX and SUFFIX are strings to print before and after each progress. +Argument FUNC are execution for eash progress; this is generally the actual +task work." + (let* ((total (length sequence)) (count 0) + (offset (eask-2str (length (eask-2str total))))) + (mapc + (lambda (item) + (cl-incf count) + (eask-with-progress + (format (concat "%s [%" offset "d/%d] %s... ") prefix count total + (ansi-green item)) + (when func (funcall func item)) + suffix)) + sequence))) + +(defun eask-print-log-buffer (&optional buffer-or-name) + "Loop through each line and print each line with corresponds log level. + +You can pass BUFFER-OR-NAME to replace current buffer." + (with-current-buffer (or buffer-or-name (current-buffer)) + (goto-char (point-min)) + (while (not (eobp)) + (let ((line (buffer-substring-no-properties (line-beginning-position) (line-end-position)))) + (cond ((string-match-p "[: ][Ee]rror: " line) (eask-error line)) + ((string-match-p "[: ][Ww]arning: " line) (eask-warn line)) + (t (eask-log line)))) + (forward-line 1)))) + +(defun eask-delete-file (filename) + "Delete a FILENAME from disk." + (let (deleted) + (eask-with-progress + (format "Deleting %s... " filename) + (eask-with-verbosity 'log + (setq deleted (file-exists-p filename)) + (ignore-errors (delete-file filename)) + (setq deleted (and deleted (not (file-exists-p filename))))) + (if deleted "done ✓" "skipped ✗")) + deleted)) + +;; +;;; Action + +(defvar eask--action-prefix "" + "The prefix to display before each package action.") + +(defvar eask--action-index 0 + "The index ID for each task.") + +(defun eask--action-format (len) + "Construct action format by LEN." + (setq len (eask-2str len)) + (concat "[%" (eask-2str (length len)) "d/" len "] ")) + ;; ;;; Archive +(defun eask--locate-archive-contents (archive) + "Locate ARCHIVE's contents file." + (let* ((name (cond ((consp archive) (car archive)) + (t archive))) + (file "archive-contents") + (dir (expand-file-name (concat "archives/" name) package-user-dir))) + (expand-file-name file dir))) + +(defun eask--package-download-one-archive (fnc &rest args) + "Execution around function `package-download-one-archive'. + +Arguments FNC and ARGS are used for advice `:around'." + (cl-incf eask--action-index) + (let* ((archive (nth 0 args)) + (name (car archive)) + (url (cdr archive)) + (fmt (eask--action-format (length package-archives))) + (download-p)) + (eask-with-verbosity-override 'log + (when (= 1 eask--action-index) (eask-msg "")) + (eask-with-progress + (format " - %sDownloading %s (%s)... " + (format fmt eask--action-index) + (ansi-green (eask-2str name)) + (ansi-yellow (eask-2str url))) + (eask-with-verbosity 'debug + (apply fnc args) + (setq download-p t)) + (cond (download-p "done ✓") + (t "failed ✗")))))) + (defun eask--download-archives () "If archives download failed; download it manually." (dolist (archive package-archives) + (cl-incf eask--action-index) (let* ((name (car archive)) - (file "archive-contents") - (dir (expand-file-name (concat "archives/" name) package-user-dir)) - (local-file (expand-file-name file dir)) - (url (format - "https://raw.githubusercontent.com/emacs-eask/archives/master/%s/%s" name file)) + (local-file (eask--locate-archive-contents archive)) + (dir (file-name-directory local-file)) ; ~/.emacs.d/elpa/archives/{name} + (file (file-name-nondirectory local-file)) ; archive-contents + (url (format "https://raw.githubusercontent.com/emacs-eask/archives/master/%s/" name)) + (url-file (concat url file)) (download-p) - (local-archive-p (string= name "local"))) ; exclude local elpa + (local-archive-p (string= name "local")) ; exclude local elpa + (fmt (eask--action-format (length package-archives)))) (unless (file-exists-p local-file) - (eask-with-progress - (format "Downloading archive `%s' manually... " (ansi-yellow name)) - (unless local-archive-p - (if (url-file-exists-p url) - (progn - (ignore-errors (make-directory dir t)) - (url-copy-file url local-file t) - (setq download-p t)) - (eask-debug "No archive-contents found in `%s'" (ansi-yellow name)))) - (cond (download-p "done ✓") - (local-archive-p "skipped ✗") - (t "failed ✗")))) + (eask-with-verbosity-override 'log + (when (= 1 eask--action-index) (eask-msg "")) + (eask-with-progress + (format " - %sDownloading %s (%s) manually... " + (format fmt eask--action-index) + (ansi-green name) + (ansi-yellow url)) + (eask-with-verbosity 'debug + (unless local-archive-p + (if (url-file-exists-p url-file) + (progn + (ignore-errors (make-directory dir t)) + (url-copy-file url-file local-file t) + (setq download-p t)) + (eask-debug "No archive-contents found in `%s'" (ansi-green name))))) + (cond (download-p "done ✓") + (local-archive-p "skipped ✗") + (t "failed ✗"))))) (when download-p (eask-pkg-init t))))) ;; @@ -258,14 +381,13 @@ Argument BODY are forms for execution." "Like function `mapc' but for process package transaction specifically. For arguments FUNC and DEPS, see function `mapc' for more information." - (let* ((eask--package-prefix) ; remain untouch + (let* ((eask--action-prefix) ; remain untouch (len (length deps)) - (len-str (eask-2str len)) - (fmt (concat "[%" (eask-2str (length len-str)) "d/" len-str "] ")) + (fmt (eask--action-format len)) (count 0)) (dolist (pkg deps) (cl-incf count) - (setq eask--package-prefix (format fmt count)) + (setq eask--action-prefix (format fmt count)) (funcall func pkg)))) (defun eask--install-deps (dependencies msg) @@ -330,8 +452,9 @@ If the argument FORCE is non-nil, force initialize packages in this session." (eask-with-progress (ansi-green "Loading package information... ") (eask-with-verbosity 'debug - (package-initialize t) (package-refresh-contents) - (eask--download-archives)) + (package-initialize t) + (let ((eask--action-index 0)) (package-refresh-contents)) + (let ((eask--action-index 0)) (eask--download-archives))) (ansi-green "done ✓")))) (defun eask--pkg-transaction-vars (pkg) @@ -381,9 +504,6 @@ Argument BODY are forms for execution." "Return non-nil if package (PKG) is installable." (assq (eask-intern pkg) package-archive-contents)) -(defvar eask--package-prefix "" - "The prefix to display before each package action.") - (defun eask-package-install (pkg) "Install the package (PKG)." (eask-defvc< 27 (eask-pkg-init)) ; XXX: remove this after we drop 26.x @@ -391,7 +511,7 @@ Argument BODY are forms for execution." (cond ((package-installed-p pkg) (eask-msg " - %sSkipping %s (%s)... already installed ✗" - eask--package-prefix + eask--action-prefix name version)) ((progn (eask-pkg-init) @@ -403,15 +523,15 @@ Argument BODY are forms for execution." ((version< emacs-version req-emacs))) (if (eask-strict-p) (eask-error " - %sSkipping %s (%s)... it requires Emacs %s and above ✗" - eask--package-prefix + eask--action-prefix pkg (eask-package--version-string pkg) emacs-version) (eask-msg " - %sSkipping %s (%s)... it requires Emacs %s and above ✗" - eask--package-prefix + eask--action-prefix name version (ansi-yellow emacs-version))))) (t (eask--pkg-process pkg (eask-with-progress - (format " - %sInstalling %s (%s)... " eask--package-prefix name version) + (format " - %sInstalling %s (%s)... " eask--action-prefix name version) (eask-with-verbosity 'debug ;; XXX Without ignore-errors guard, it will trigger error ;; @@ -428,11 +548,11 @@ Argument BODY are forms for execution." (eask--pkg-process pkg (cond ((not (package-installed-p pkg)) - (eask-msg " - %sSkipping %s (%s)... not installed ✗" eask--package-prefix name version)) + (eask-msg " - %sSkipping %s (%s)... not installed ✗" eask--action-prefix name version)) (t (eask--pkg-process pkg (eask-with-progress - (format " - %sUninstalling %s (%s)... " eask--package-prefix name version) + (format " - %sUninstalling %s (%s)... " eask--action-prefix name version) (eask-with-verbosity 'debug (package-delete (eask-package-desc pkg t) (eask-force-p))) "done ✓")))))) @@ -443,12 +563,12 @@ Argument BODY are forms for execution." (eask--pkg-process pkg (cond ((not (package-installed-p pkg)) - (eask-msg " - %sSkipping %s (%s)... not installed ✗" eask--package-prefix name version)) + (eask-msg " - %sSkipping %s (%s)... not installed ✗" eask--action-prefix name version)) (t (eask-pkg-init) (eask--pkg-process pkg (eask-with-progress - (format " - %sReinstalling %s (%s)... " eask--package-prefix name version) + (format " - %sReinstalling %s (%s)... " eask--action-prefix name version) (eask-with-verbosity 'debug (package-delete (eask-package-desc pkg t) t) (eask-ignore-errors (package-install pkg))) @@ -1256,6 +1376,14 @@ Execute forms BODY limit by the verbosity level (SYMBOL)." `(if (eask--reach-verbosity-p ,symbol) (progn ,@body) (eask--silent ,@body))) +(defmacro eask-with-verbosity-override (symbol &rest body) + "Define override verbosity scope. + +Execute forms BODY limit by the verbosity level (SYMBOL)." + (declare (indent 1) (debug t)) + `(if (eask--reach-verbosity-p ,symbol) (eask--unsilent ,@body) + (eask--silent ,@body))) + (defun eask--ansi (symbol string) "Paint STRING with color defined by log level (SYMBOL)." (if-let ((ansi-function (cdr (assq symbol eask-level-color)))) @@ -1495,76 +1623,6 @@ Arguments FNC and ARGS are used for advice `:around'." (cl-incf size (file-attribute-size (file-attributes filename)))) (string-trim (ls-lisp-format-file-size size t)))) -;; -;;; Progress - -(defcustom eask-elapsed-time nil - "Log with elapsed time." - :type 'boolean - :group 'eask) - -(defcustom eask-minimum-reported-time 0.1 - "Minimal load time that will be reported." - :type 'number - :group 'eask) - -(defmacro eask-with-progress (msg-start body msg-end) - "Progress BODY wrapper with prefix (MSG-START) and suffix (MSG-END) messages." - (declare (indent 0) (debug t)) - `(if eask-elapsed-time - (let ((now (current-time))) - (ignore-errors (eask-write ,msg-start)) ,body - (let ((elapsed (float-time (time-subtract (current-time) now)))) - (if (< elapsed eask-minimum-reported-time) - (ignore-errors (eask-msg ,msg-end)) - (ignore-errors (eask-write ,msg-end)) - (eask-msg (ansi-white (format " (%.3fs)" elapsed)))))) - (ignore-errors (eask-write ,msg-start)) ,body - (ignore-errors (eask-msg ,msg-end)))) - -(defun eask-progress-seq (prefix sequence suffix func) - "Shorthand to progress SEQUENCE of task. - -Arguments PREFIX and SUFFIX are strings to print before and after each progress. -Argument FUNC are execution for eash progress; this is generally the actual -task work." - (let* ((total (length sequence)) (count 0) - (offset (eask-2str (length (eask-2str total))))) - (mapc - (lambda (item) - (cl-incf count) - (eask-with-progress - (format (concat "%s [%" offset "d/%d] %s... ") prefix count total - (ansi-green item)) - (when func (funcall func item)) - suffix)) - sequence))) - -(defun eask-print-log-buffer (&optional buffer-or-name) - "Loop through each line and print each line with corresponds log level. - -You can pass BUFFER-OR-NAME to replace current buffer." - (with-current-buffer (or buffer-or-name (current-buffer)) - (goto-char (point-min)) - (while (not (eobp)) - (let ((line (buffer-substring-no-properties (line-beginning-position) (line-end-position)))) - (cond ((string-match-p "[: ][Ee]rror: " line) (eask-error line)) - ((string-match-p "[: ][Ww]arning: " line) (eask-warn line)) - (t (eask-log line)))) - (forward-line 1)))) - -(defun eask-delete-file (filename) - "Delete a FILENAME from disk." - (let (deleted) - (eask-with-progress - (format "Deleting %s... " filename) - (eask-with-verbosity 'log - (setq deleted (file-exists-p filename)) - (ignore-errors (delete-file filename)) - (setq deleted (and deleted (not (file-exists-p filename))))) - (if deleted "done ✓" "skipped ✗")) - deleted)) - ;; ;;; Help diff --git a/lisp/core/install-deps.el b/lisp/core/install-deps.el index 73e63178..3ba4d764 100644 --- a/lisp/core/install-deps.el +++ b/lisp/core/install-deps.el @@ -15,6 +15,9 @@ nil t)) (eask-start + ;; XXX: You must refresh content before you install the package, + ;; see https://github.com/ericdallo/jet.el/issues/1 + (eask-pkg-init) (if (eask-dependencies) (progn (when (and (eask-dev-p) (not eask-depends-on-dev)) diff --git a/lisp/core/refresh.el b/lisp/core/refresh.el index 60b5dade..66d0a48c 100644 --- a/lisp/core/refresh.el +++ b/lisp/core/refresh.el @@ -15,8 +15,9 @@ nil t)) (eask-start + (advice-add 'package--download-one-archive :around #'eask--package-download-one-archive) (eask-pkg-init) (eask-msg "") - (eask-info "(Done)")) + (eask-info "(Done refresh package archives)")) ;;; core/refresh.el ends here diff --git a/lisp/lint/package.el b/lisp/lint/package.el index ed699617..90a5b018 100644 --- a/lisp/lint/package.el +++ b/lisp/lint/package.el @@ -68,7 +68,7 @@ (cond ;; Files found, do the action! (files - (eask-pkg-init) + (eask-pkg-init) ; XXX: Avoid not installable error! (setq package-lint-main-file eask-package-file) (mapcar #'eask--package-lint-file files) (eask-msg "")