;;; elpaca.el --- An elisp package manager -*- lexical-binding: t; -*-

;; Copyright (C) 2022-2026 Nicholas Vollmer

;; Author: Nicholas Vollmer

;; URL: https://github.com/progfolio/elpaca

;; Created: Jan 1, 2022

;; Keywords: tools, convenience, lisp

;; Package-Requires: ((emacs "27.1"))

;; Version: 0.1.3

;; This file is not part of GNU Emacs.

;; This program is free software; you can redistribute it and/or modify

;; it under the terms of the GNU General Public License as published by

;; the Free Software Foundation, either version 3 of the License, or

;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,

;; but WITHOUT ANY WARRANTY; without even the implied warranty of

;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the

;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License

;; along with this program. If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;;; Code:

(eval-and-compile (require 'cl-lib))

(eval-when-compile (require 'subr-x))

(require 'cl-generic)

(cl-declaim (optimize (safety 0) (speed 3)))

(require 'elpaca-process)

(declare-function autoload-rubric "autoload")

(declare-function info-initialize "info")

(defvar autoload-timestamps)

(defvar generated-autoload-file)

(defvar Info-directory-list)

(defconst elpaca--inactive-states '(blocked finished failed))

(defvar elpaca-installer-version -1)

(or noninteractive (= elpaca-installer-version 0.12)

(lwarn '(elpaca installer) :warning "%s installer version does not match %s."

(or (symbol-file 'elpaca-installer-version 'defvar) "Init")

(expand-file-name "./doc/installer.el" (file-name-directory (or load-file-name (buffer-file-name))))))

(and (not after-init-time) load-file-name (featurep 'package) (warn "Package.el loaded before Elpaca"))

(defgroup elpaca nil "An elisp package manager." :group 'applications :prefix "elpaca-")

(defface elpaca-finished '((t (:inherit success))) "Indicates an order is finished.")

(defface elpaca-busy '((t (:inherit warning :inverse-video t)))

"Indicates order's subprocess has not produced output in `elpaca-busy-interval'.")

(defface elpaca-blocked '((t (:inherit warning))) "Indicates an order is blocked.")

(defface elpaca-failed '((t (:inherit error))) "Indicates an order has failed.")

(defcustom elpaca-status-faces '((blocked . elpaca-blocked)

(finished . elpaca-finished)

(failed . elpaca-failed)

(busy . elpaca-busy))

"Alist mapping order statuses to faces."

:type '(alist :key-type symbol :options (blocked finished failed busy) :value-type face))

(defvar elpaca--pre-built-steps

'(elpaca-queue-dependencies elpaca-activate)

"List of steps for packages which are already built.")

(defvar elpaca-after-init-time nil "`current-time' after processing all queues.")

(defcustom elpaca-after-init-hook nil

"Elpaca's analogue to `after-init-hook'.

This is run after all orders queued during init have finished processing.

It is only run once after init.

Note a blocked process will prevent this hook from being run."

:type 'hook)

(defcustom elpaca-post-queue-hook nil

"Hook run after a queue is finished processing.

Note blocked or failed orders will prevent this hook from being run."

:type 'hook)

(defcustom elpaca-queue-limit nil

"When non-nil, limit the number of orders which can be processed at once."

:type 'integer)

(defcustom elpaca-cache-autoloads t

"If non-nil, cache package autoloads and load all at once.

Results in faster start-up time." :type 'boolean)

(defcustom elpaca-directory (expand-file-name "elpaca" user-emacs-directory)

"Location of the elpaca package store." :type 'directory)

(defvar elpaca-cache-directory (expand-file-name "cache" elpaca-directory)

"Location of the cache directory.")

(defvar elpaca-builds-directory (expand-file-name "builds" elpaca-directory)

"Location of the builds directory.")

(defvar elpaca-sources-directory (expand-file-name "sources" elpaca-directory)

"Location of the sources directory.")

(defcustom elpaca-makeinfo-executable (executable-find "makeinfo")

"Path of the makeinfo executable." :type '(file :must-match t))

(defcustom elpaca-install-info-executable (executable-find "install-info")

"Path of the install-info executable." :type '(file :must-match t))

(defvar elpaca--log-timer nil "Timer to debounce order info printing.")

(defcustom elpaca-log-interval 0.02

"Number of idle seconds to wait before updating log buffer.

Setting this to too low may cause the status buffer to block more.

Setting it too high causes prints fewer status updates."

:type 'number)

(defcustom elpaca-busy-interval 60

"Seconds to wait between subprocess outputs before declaring process blocked."

:type 'number)

(defcustom elpaca-default-build-steps '(elpaca-source

elpaca-queue-dependencies

elpaca-check-version

elpaca-build-link

elpaca-build-autoloads

elpaca-build-compile

elpaca-build-docs

elpaca-activate)

"List of steps which are run when installing/building a package."

:type '(repeat function))

(defvar elpaca--debug-init init-file-debug "Preserves --debug-init option.")

(defvar elpaca-default-files-directive

'("*.el" "*.el.in" "dir" "*.info" "*.texi" "*.texinfo"

"doc/dir" "doc/*.info" "doc/*.texi" "doc/*.texinfo" "lisp/*.el"

"docs/dir" "docs/*.info" "docs/*.texi" "docs/*.texinfo"

(:exclude ".dir-locals.el" "test.el" "tests.el" "*-test.el" "*-tests.el" "LICENSE"

"README*" "*-pkg.el"))

"Default value for the `:files' directive in recipes.

It is also spliced in at any point where the `:defaults' keyword

is used in a `:files' directive.")

(defvar elpaca-order-defaults (list :type 'git :protocol 'https :inherit t :depth 'treeless)

"Default order modifications.")

(defun elpaca-order-defaults (_order) "Return order defaults." elpaca-order-defaults)

(defcustom elpaca-order-functions '(elpaca-order-defaults)

"Abnormal hook run to alter orders.

Each element must be a unary function which accepts an order plist.

The function may return nil or a plist to be merged with the order.

This hook is run via `elpaca-run-hooks-with-reduce'."

:type 'hook)

(defcustom elpaca-recipe-functions nil

"Abnormal hook run to alter recipes.

Each element must be a unary function which accepts an recipe plist.

The function may return nil or a plist to be merged with the recipe.

This hook is run via `elpaca-run-hooks-with-reduce'."

:type 'hook)

(defsubst elpaca-alist-get (key alist &optional default)

"Return KEY's value in ALIST or DEFAULT.

Simplified, faster version of `alist-get'."

(or (cdr (assq key alist)) default))

(defvar elpaca-menu-extensions--cache nil "Cache for `elpaca-menu-extenions' items.")

(defun elpaca-menu-extensions (request &optional item)

"Return menu ITEM REQUEST."

(if-let* (((eq request 'index))

(cache (or elpaca-menu-extensions--cache (elpaca-menu-extensions 'update))))

(if item (elpaca-alist-get item cache) cache)

(setq elpaca-menu-extensions--cache

(list (cons 'elpaca-use-package

(list :source "Elpaca extensions"

:description "Elpaca use-package support."

:recipe (list :package "elpaca-use-package" :wait t

:repo "https://github.com/progfolio/elpaca.git"

:files '("extensions/elpaca-use-package.el")

:main "extensions/elpaca-use-package.el"

:build '(:not elpaca-build-docs))))))))

(defcustom elpaca-menu-functions

'( elpaca-menu-lock-file elpaca-menu-extensions elpaca-menu-org elpaca-menu-melpa

elpaca-menu-nongnu-elpa elpaca-menu-gnu-elpa elpaca-menu-declarations)

"Abnormal hook to lookup packages in menus.

Each function is passed a request, which may be any of the following symbols:

- `index`

Must return a alist of the menu's package candidates.

Each candidate is a cell of form:

(PACKAGE-NAME . (:source SOURCE-NAME :recipe RECIPE-PLIST))

- `update`

Updates the menu's package candidate list.

Each function must also accept an optional ITEM as a second argument."

;;@TODO: document ITEM spec requirements

:type 'hook)

(defcustom elpaca-verbosity 0 "Maximum event verbosity level shown in logs."

:type 'integer)

(defcustom elpaca-default-remote-name "origin" "Default remote name." :type 'string)

;;@COMPAT @HACK:

;;Transient not in `package--builtin-versions' from addition in 28.1 until Emacs 30.

(when-let* (((< 27 emacs-major-version 30))

(transient-versions '(("28.1" . (0 3 7)) ("28.2" . (0 3 7))

("29.1" . (0 4 1)) ("29.2" . (0 4 3))

("29.3" . (0 4 3)) ("29.4" . (0 4 3)))))

(add-to-list 'package--builtin-versions

(cons 'transient (alist-get emacs-version transient-versions

nil nil #'string-prefix-p))))

(defcustom elpaca-ignored-dependencies (mapcar #'car package--builtin-versions)

"List of IDs which are not installed unless the user explicitly requests them."

:type '(repeat symbol))

(defvar elpaca-overriding-prompt nil "Overriding prompt for interactive functions.")

(defun elpaca--read-file (path)

"Read file at PATH into memory."

(when-let* (((file-exists-p path))

(dir default-directory))

(condition-case-unless-debug err

(with-current-buffer (get-buffer-create " elpaca--read-file")

(setq default-directory dir)

(insert-file-contents path nil nil nil 'replace)

(goto-char (point-min))

(read (current-buffer)))

((error) (warn "Error reading %S into memory: %S" path err) nil))))

(defmacro elpaca--write-file (file &rest body)

"Write FILE using BODY.

`standard-output' and print variables are lexically bound for convenience.

e.g. elisp forms may be printed via `prin1'."

(declare (indent 1) (debug t))

`(let ((coding-system-for-write 'utf-8))

(with-temp-file ,file

(let* ((standard-output (current-buffer))

print-circle print-level print-length)

,@body

nil))))

(cl-defstruct (elpaca-q (:constructor elpaca-q<-create)

(:type list) (:copier nil)

(:named) (:conc-name elpaca-q<-))

"Queue to hold elpacas."

(type (when (or (not after-init-time)

(let ((init (expand-file-name "init.el" user-emacs-directory)))

(member init (list load-file-name (buffer-file-name)))))

'init))

(id (if (boundp 'elpaca--queues) (length elpaca--queues) 0))

(processed 0)

(status 'incomplete)

(time (current-time))

autoloads forms elpacas)

(defvar elpaca--queues (list (elpaca-q<-create)) "List of elpaca queue objects.")

(defun elpaca-merge-plists (&rest plists)

"Return plist with set of unique keys from PLISTS.

Values for each key are that of the right-most plist containing that key."

(let ((plists (delq nil plists))

current plist)

(while (setq current (pop plists))

(while current (setq plist (plist-put plist (pop current) (pop current)))))

plist))

(defsubst elpaca--first (obj)

"Return `car' of OBJ if it is a list, else OBJ."

(if (listp obj) (car obj) obj))

(defsubst elpaca--q (e)

"Return E's Q."

(and e (car (last elpaca--queues (1+ (elpaca<-queue-id e))))))

(defun elpaca--completion-group-by-menu (candidate transform)

"Return CANDIDATE menu if TRANSFORM non-nil, otherwise CANDIDATE item."

(if-let* ((space (string-match-p " " candidate)))

(substring candidate (if transform 0 (1+ space)) (when transform space))

candidate))

(defcustom elpaca-description-column 20 "Minimum column for completion descriptions."

:type 'number)

(defun elpaca--completion-affixation-fn (candidates)

"Return `elpaca-menu-item' CANDIDATES affixation function."

(let ((col elpaca-description-column))

(lambda (completions)

(setq col (max col (or (cl-loop for c in completions maximize (string-match-p " " c)) 0)))

(mapcar

(lambda (c) (list c ""

(concat (propertize " " 'display `(space :align-to ,col))

(when-let* ((item (cdr (assoc-string c candidates)))

(desc (plist-get (cdr item) :description)))

(propertize (concat " " desc) 'face 'completions-annotations)))))

completions))))

;;;###autoload

(defun elpaca-menu-item (&optional id interactive)

"Return menu item matching ID in `elpaca-menu-functions'.

If ID is nil, prompt for item. If INTERACTIVE is non-nil, copy to `kill-ring'.

When INTERACTIVE equals \\[universal-argument], copy as an order declaration."

(interactive (list nil (or current-prefix-arg t)))

(let ((item

(if id (run-hook-with-args-until-success 'elpaca-menu-functions 'index id) ;; Depth first search

(cl-loop

for menu in elpaca-menu-functions

append (cl-loop for i in (funcall menu 'index) collect

(cons (concat (symbol-name (car i)) " " (plist-get (cdr i) :source)) i))

into candidates

finally return

(let ((choice (completing-read

(or elpaca-overriding-prompt "Menu Item: ")

(lambda (string pred action)

(if (eq action 'metadata)

`(metadata . ((group-function . elpaca--completion-group-by-menu)

(affixation-function . ,(elpaca--completion-affixation-fn candidates))))

(complete-with-action action candidates string pred)))

nil t)))

(alist-get choice candidates nil nil #'equal))))))

(when interactive

(when (consp interactive) (setq item (cons (car item) (plist-get (cdr item) :recipe))))

(message "menu-item copied to kill-ring:\n%S" item)

(kill-new (format "%S" item)))

item))

;;;###autoload

(defun elpaca-update-menus (&rest menus)

"Update all menus in MENUS or `elpaca-menu-functions'.

When called interactively with \\[universal-argument] update all menus."

(interactive (if (equal current-prefix-arg '(4))

elpaca-menu-functions

(mapcar #'intern (completing-read-multiple "Update Menus: "

elpaca-menu-functions))))

(let ((elpaca-menu-functions (or menus elpaca-menu-functions)))

(run-hook-with-args 'elpaca-menu-functions 'update)))

(defun elpaca--order (&optional err)

"Prompt for order. User ERR is messaged when no order selected."

(if-let* ((elpaca-overriding-prompt (or elpaca-overriding-prompt "Order: "))

(item (elpaca-menu-item)))

(cons (car item) (plist-get (cdr item) :recipe))

(user-error (or err "No order selected"))))

(defun elpaca-run-hook-with-reduce (object hooks)

"Run HOOKS against OBJECT. Return merged non-nil results."

(cl-loop with modifications for hook in (if (functionp hooks) (list hooks) hooks)

do (setq modifications (funcall hook object))

(when modifications (setq object (elpaca-merge-plists object modifications)))

finally return object))

(defun elpaca--normalize-order (order)

"Return proper plist from ORDER."

(unless (keywordp (car-safe order))

(setq order `( :package ,(symbol-name (elpaca--first order))

:id ,@(if (listp order) order (list order)))))

(condition-case err

(if-let* ((declared (plist-member order :inherit))

((not (cadr declared))))

order

(elpaca-merge-plists (elpaca-run-hook-with-reduce order elpaca-order-functions)

order))

(error (signal 'elpaca-order-error (cons order err)))))

(defun elpaca--normalize-recipe (order &optional item-resolved)

"Return recipe for normalized ORDER plist.

Skip menu item lookup when ITEM-RESOLVED is non-nil."

(let* ((inherit (or (plist-member order :inherit) '(:inherit t))) ;; Implicitly inheritable

(inheritance (cadr inherit))

(item (let ((elpaca-menu-functions

(unless (or item-resolved (null inheritance))

(if-let* ((menus inheritance)

((not (eq menus t))))

(if (listp menus) menus (list menus))

elpaca-menu-functions))))

(elpaca-menu-item (plist-get order :id))))

(item-recipe (plist-put (plist-get item :recipe) :source (plist-get item :source)))

(recipe (if-let* ((r (elpaca-merge-plists item-recipe order))

(inheritance))

(elpaca-run-hook-with-reduce r elpaca-recipe-functions)

r)))

(when-let* ((remotes (plist-get recipe :remotes)) ;; Normalize :remotes to list of specs

((not (ignore-errors (mapc #'length remotes)))))

(setq recipe (plist-put recipe :remotes (list remotes))))

recipe))

;;;###autoload

(defun elpaca-recipe (&optional order interactive)

"Return recipe computed from ORDER.

ORDER is any of the following values:

- nil. The order is prompted for.

- an ID symbol, looked up in ITEMS or `elpaca-menu-functions' cache.

- an order list of the form: \\='(ID . PROPS).

When INTERACTIVE is non-nil, `yank' the recipe to the clipboard."

(interactive (list (elpaca--order) (or current-prefix-arg t)))

(let* ((prompted (null order))

(order (elpaca--normalize-order (or order (elpaca--order))))

(recipe (elpaca--normalize-recipe order (or interactive prompted)))

(id (plist-get order :id)))

(when interactive

(unless (listp interactive) (setq recipe (cons id recipe)))

(kill-new (format "%S" recipe))

(message "%S recipe copied to kill-ring:\n%S" id recipe))

recipe))

(defsubst elpaca--emacs-path ()

"Return path to running Emacs."

(concat invocation-directory invocation-name))

(defvar elpaca--source-dirs nil "List of registered repository directories.")

(defun elpaca-build-dir (recipe)

"Return RECIPE's build dir."

(expand-file-name (plist-get recipe :package) elpaca-builds-directory))

(cl-defstruct (elpaca (:constructor elpaca<--create) (:type list) (:named)

(:conc-name elpaca<-))

"Order for queued processing."

id package declaration order statuses

build-dir source-dir main

files build-steps recipe blocking blockers

dependencies dependents

(queue-id (1- (length elpaca--queues)))

(queue-time (current-time))

(init (not after-init-time))

process log builtp)

(cl-generic-define-generalizer elpaca--generic-derived-generalizer

70 (lambda (name &rest _) `(plist-get (elpaca<-recipe ,name) :type))

(lambda (tag &rest _) `((elpaca ,tag))))

(cl-defmethod cl-generic-generalizers ((_specializer (head elpaca)))

"Support for (elpaca TYPE) specializers."

(list elpaca--generic-derived-generalizer))

(defun elpaca--queued (&optional n)

"Return list of elpacas from Nth queue.

If N is nil return a list of all queued elpacas."

(if n (elpaca-q<-elpacas (nth n elpaca--queues))

(cl-loop for queue in elpaca--queues append (elpaca-q<-elpacas queue))))

(defun elpaca--shared-source-dir (id dir)

"Return most recent previously queued E same source DIR as ID."

(cl-loop with queued = (elpaca--queued)

with index = (or (cl-loop for i from 0 to (length queued)

when (eq (car (nth i queued)) id) return i)

(cl-return nil))

for i from (1- index) downto 0

for e = (cdr (nth i queued))

when (and e

(equal dir (elpaca<-source-dir e)))

return e))

(defun elpaca-substitute-build-steps (steps &rest rules)

"Alter build STEPS via substituion RULES.

RULES is a lists of specs of the form ((TYPE TARGET SUBSTITUTIONS...)...).

RULES may also be a single substitution spec.

The SUBSTITUTIONS are the function symbols which replace the TARGET.

TYPE is one of the following keywords:

- :after places SUBSTITUTIONS after TARGET.

- :before places SUBSTITUTIONS before TARGET.

- :first places SUBSTITUTIONS at the beginning of the list.

- :last places SUBSTITUTIONS at the end of the list.

- :sub replaces TARGET with SUBSTITUTIONS.

- :not removes TARGET and SUBSTITUTIONS."

(cl-loop

with specs = (cl-loop with result for el in rules

do (if (keywordp (car-safe el))

(push el result)

(cl-loop for spec in el do (push spec result)))

finally return (nreverse result))

with steps = (copy-tree steps) ; Prevent altering quoted step forms

for (type target . subs) in specs do

(cl-loop named scanner initially do

(progn (pcase type

(:not (setq subs (when target (cons target subs))

steps (cl-loop for step in steps

unless (memq step subs)

collect step)))

(:before (setq subs (append subs (list target))))

(:after (setq subs (cons target subs)))

(:first (setq steps (append (cons target subs) steps)))

(:last (setq steps (append steps (cons target subs))))

(:sub (setq steps (cl-loop for step in steps

if (eq step target) append subs

else collect step)))

(unknown (error "Unknown substituion rule: %S" unknown)))

(unless (memq type '(:before :after)) (cl-return-from scanner)))

with i = 0 while (< i (length steps)) do

(if-let* ((step (nth i steps))

((eq step target)))

(progn (setf (nthcdr i steps)

(append subs (nthcdr (1+ i) steps))

i (+ i (length steps)))

(cl-return-from scanner))

(cl-incf i)))

finally return steps))

;;@HACK: Wouldn't be necessary if cl-generic supported :most-specific-last method combination

(defcustom elpaca-most-specific-last-methods (list 'elpaca-build-steps 'elpaca--version)

"List of methods which will be combined in most-specific-last order." :type '(list symbol))

(cl-defmethod cl-generic-combine-methods :around (generic methods)

"Combine GENERIC METHODS in most-specific-last order."

(cl--generic-standard-method-combination

generic (if (memq (cl--generic-name generic) elpaca-most-specific-last-methods)

(reverse methods) methods)))

(cl-defgeneric elpaca-source (e)

"Populate E's source directory with E's files."

(error "No elpaca-source method for :type %S" (plist-get (elpaca<-recipe e) :type)))

(cl-defgeneric elpaca-build-steps (e &optional context)

"Return E's build steps for CONTEXT." ;;@MAYBE: allow :build function for CONTEXT.

(let* ((recipe (elpaca<-recipe e))

(declaration (plist-member recipe :build))

(val (cadr declaration)))

(unless (and declaration (not val)) ;; explicit nil

(elpaca-substitute-build-steps

(pcase context

('nil (if (elpaca<-builtp e) elpaca--pre-built-steps elpaca-default-build-steps))

((or :rebuild :merge)

(cl-set-difference elpaca-default-build-steps

(cons 'elpaca-source elpaca--pre-built-steps))))

(condition-case err

(cl-call-next-method)

((cl-no-next-method) nil)

((error) (signal (car err) (cdr err))))

val))))

(defsubst elpaca--status (e) "Return E's status." (car (elpaca<-statuses e)))

(defcustom elpaca-log-command-queries

'(((elpaca-fetch elpaca-fetch-all elpaca-log-updates) . "#latest #update-log")

((elpaca-try elpaca-rebuild) . "#latest #linked-errors")

(( elpaca-merge elpaca-merge-all elpaca-pull elpaca-pull-all

elpaca-update elpaca-update-all)

. "#latest #unique")

((eval-buffer eval-region eval-defun eval-last-sexp org-ctrl-c-ctrl-c) . silent)

(elpaca-delete . (lambda () (if (derived-mode-p 'elpaca-ui-mode)

elpaca-ui-search-query 'silent)))

(elpaca-ui-execute-marks . (lambda () (require 'elpaca-log) (elpaca-log--marked-query))))

"Alist of form ((COMMAND-OR-COMMAND-LIST . QUERY-OR-FUNCTION)...).

If query is a string it is used when logging for that command.

If it is a function, it's return value is used."

:type 'alist :group 'elpaca-ui)

(defun elpaca--log-find-command (val key)

"Return t if KEY VAL."

(or (eq key val) (and (listp val) (member key val))))

(defun elpaca-log-command-query ()

"Return logging query matching `this-command' in `elpaca-log-command-queries'."

(when-let* ((found (alist-get this-command elpaca-log-command-queries

nil nil #'elpaca--log-find-command)))

(if (functionp found) (funcall found) found)))

(defun elpaca-log-initial-queues ()

"Return logging query if initial queues require building or order fails."

(unless elpaca-after-init-time

(cl-loop for (_ . e) in (elpaca--queued)

for query = (cond ((not (elpaca<-builtp e)) "#unique | !finished")

((eq (elpaca--status e) 'failed) "| failed"))

when query return

(prog1 query

(setq initial-buffer-choice

(let ((ibc initial-buffer-choice))

(lambda ()

(add-hook 'elpaca-after-init-hook

(lambda () (setq initial-buffer-choice ibc)))

(get-buffer-create "*elpaca-log*"))))))))

(declare-function elpaca-log-defaults "elpaca-log")

(declare-function elpaca-log-initial-queues "elpaca-log")

(defcustom elpaca-log-functions '(elpaca-log-initial-queues elpaca-log-command-query)

"Hook run prior to logging.

It's functions should return either:

- t to log with the buffer's default filter.

- a string which is used as the search query.

- `silent' to prevent logging altogether.

- nil to skip the function.

The first function, if any, which returns non-nil is used." :type 'hook)

(defvar elpaca--log-request-time nil "Time of most recent log event.")

(declare-function elpaca-log "elpaca-log")

(defun elpaca--maybe-log ()

"Log if `elpaca-log-functions' return non-nil."

(when-let* ((query (run-hook-with-args-until-success 'elpaca-log-functions)))

(require 'elpaca-log)

(unless (eq query 'silent)

(setq elpaca--log-request-time (current-time)) ;;@MAYBE: move into elpaca-log?

(elpaca-log (cond ((eq query t) nil)

((stringp query) query)

(t (signal 'wrong-type-error `((stringp t) ,query))))

t))))

(defcustom elpaca-types '((git . elpaca-git)

(tar . elpaca-tar)

(file . elpaca-file))

"Alist of form ((SYM . LIBRARY)). SYM is a valid recipe :type symbol."

:type 'alist)

(cl-defgeneric elpaca-source-dir (e)

"Return E's source directory."

(expand-file-name (elpaca<-package e) elpaca-sources-directory))

(defun elpaca<-create (declaration)

"Create a new elpaca struct from DECLARATION."

(let* ((id (elpaca--first declaration))

(e (elpaca<--create :id id :package (symbol-name id) :declaration declaration)))

(condition-case err

(progn

(setf (elpaca<-order e) (elpaca--normalize-order declaration)

(elpaca<-recipe e) (elpaca--normalize-recipe (elpaca<-order e))

(elpaca<-build-dir e) (elpaca-build-dir (elpaca<-recipe e))

(elpaca<-builtp e) (when-let* ((build-dir (elpaca<-build-dir e)))

(file-exists-p build-dir)))

(when-let* ((recipe (elpaca<-recipe e))

(registered (elpaca-alist-get (plist-get recipe :type) elpaca-types)))

(require registered)) ;;@TODO: optimize lookup by tracking separate from `features'?

(setf (elpaca<-source-dir e) (elpaca-source-dir e)

(elpaca<-build-steps e) (elpaca-build-steps e))

e)

(elpaca-error

(if (run-hook-with-args-until-success 'elpaca-error-functions e err)

(throw 'elpaca-abort nil)

(signal (car err) (cdr err)))))))

(declare-function elpaca-ui--update-search-query "elpaca-ui")

(defun elpaca--update-log-buffer ()

"Update views in `elpaca-log-buffer'."

(when-let* ((log (bound-and-true-p elpaca-log-buffer))

((get-buffer-window log t))) ;; log buffer visible

(with-current-buffer log (elpaca-ui--update-search-query log))))

(defun elpaca--log (e text &optional verbosity replace)

"Store TEXT in E's log.

Each event is of the form: (STATUS TIME TEXT (or VERBOSITY 0))

If REPLACE is non-nil, the most recent log entry is replaced."

(let ((event (list (elpaca--status e) (current-time) text (or verbosity 0))))

(if replace

(setf (car (elpaca<-log e)) event)

(push event (elpaca<-log e)))))

(defvar elpaca--waiting nil "Non-nil when `elpaca-wait' is polling.")

(defvar elpaca--status-counts nil "Status counts for UI progress bar.")

(defun elpaca--count-statuses ()

"Update `elpaca--status-counts'."

(cl-loop with statuses for q in elpaca--queues

do (cl-loop for (_ . e) in (elpaca-q<-elpacas q)

for status = (elpaca--status e)

for state = (if (memq status elpaca--inactive-states) status 'other)

do (cl-incf (alist-get state statuses 0)))

finally return statuses))

(defun elpaca--signal (e &optional info status replace verbosity)

"Signal a change to E. Return nil.

If INFO is non-nil, log and possibly print it in `elpaca-log-buffer'.

If REPLACE is non-nil, E's log is updated instead of appended.

If VERBOSITY is non-nil, log event is given that verbosity number.

If STATUS is non-nil and is not E's current STATUS, signal E's dependents to

check (and possibly change) their statuses."

(let* ((new-status-p (and status (not (eq status (elpaca--status e)))))

(queued (and new-status-p (elpaca--queued))))

(when-let* ((new-status-p)

((push status (elpaca<-statuses e)))

((memq status elpaca--inactive-states)))

(setq elpaca--status-counts (elpaca--count-statuses))

(dolist (blocked (elpaca<-blocking e))

(elpaca--check-status e (elpaca-alist-get blocked queued)))

(and (not elpaca-after-init-time) (eq status 'failed) (elpaca--maybe-log)))

(when info (elpaca--log e info verbosity replace))

(when (<= (or verbosity 0) elpaca-verbosity)

(when elpaca--log-timer (cancel-timer elpaca--log-timer))

(if elpaca--waiting ; Don't set timer. We're already polling.

(elpaca--update-log-buffer)

(setq elpaca--log-timer

(and info (run-at-time elpaca-log-interval nil #'elpaca--update-log-buffer))))))

nil)

;;@MAYBE: UI command to manually fail an order?

(define-error 'elpaca-error "Elpaca error")

(define-error 'elpaca-order-error "Elpaca order error" 'elpaca-error)

(define-error 'elpaca-recipe-error "Elpaca recipe error" 'elpaca-error)

(define-error 'elpaca-url-error "Unable to determine recipe URL" 'elpaca-recipe-error)

(define-error 'elpaca-build-error "Elpaca build error" 'elpaca-error)

(defun elpaca--fail (e &optional reason)

"Fail E for REASON, signaling an elpaca-build-error."

(when-let* ((p (elpaca<-process e))

(entry (car (last (elpaca<-log e) (process-get p :loglen)))))

(setf (nth 2 entry) (propertize (nth 2 entry) 'face 'elpaca-failed)))

(elpaca--signal e reason 'failed)

(signal 'elpaca-build-error (list e reason)))

(defun elpaca-get (id)

"Return queued E associated with ID."

(elpaca-alist-get id (elpaca--queued)))

(defun elpaca--caller-name (n &rest skip)

"Return Nth calling function's name, skipping symbols in SKIP."

(cl-loop with current = (backtrace-frame (1+ n)) ;; Skip this function call.

with previous = nil

while (or (null (car current)) (memq (cadr current) skip))

do (setq previous current current (backtrace-frame (cl-incf n)))

finally return (cadr (or current previous))))

(defun elpaca--handle-build-error (e err)

"Handle ERR for E, invoking :on-error handler or propagating."

(when-let* ((process (elpaca<-process e)))

(delete-process process))

(let ((handler (plist-get (elpaca<-recipe e) :on-error)))

(unless (and handler (funcall handler e err))

(signal (car err) (cdr err)))))

(defun elpaca--continue-build (e &rest args)

"Run E's next build step.

Optional ARGS are passed to `elpaca--signal', which see."

(elpaca--signal e (format "Continued by: %S"

(elpaca--caller-name -1 'backtrace-frame 'elpaca--process-sentinel 'apply

'elpaca--caller-name 'elpaca--continue-build))

nil nil 2)

(when args (apply #'elpaca--signal e args))

(unless (memq (elpaca--status e) elpaca--inactive-states)

(if-let* ((elpaca-queue-limit)

((not (elpaca<-builtp e)))

;; Don't double count current E

(active (1- (cl-loop for (_ . e) in (elpaca-q<-elpacas (elpaca--q e))

count (not (memq (elpaca--status e) elpaca--inactive-states)))))

((>= active elpaca-queue-limit)))

(unless (eq (elpaca--status e) 'blocked) ;;@MAYBE: check for queue-throttled, too?

(push 'queue-throttled (elpaca<-statuses e))

(elpaca--signal e "elpaca-queue-limit exceeded" 'blocked nil 1))

(let ((step (or (pop (elpaca<-build-steps e)) #'elpaca--finalize)))

(condition-case err

(if-let* ((vars (plist-get (elpaca<-recipe e) :vars))

(closure `(lambda (elpaca elpaca-build-step)

(let* (,@vars) (funcall elpaca-build-step elpaca)))))

(funcall closure e step)

(funcall step e))

(elpaca-build-error (elpaca--handle-build-error e err)))))))

(defun elpaca--log-duration (e)

"Return E's log duration."

(time-subtract (nth 1 (car (elpaca<-log e))) (elpaca<-queue-time e)))

(defun elpaca--enqueue (order &optional queue)

"ADD ORDER to QUEUE or current queue. Return E."

(if-let* ((id (elpaca--first (or order (signal 'wrong-type-argument

'((or symbolp listp) nil)))))

((not after-init-time))

(e (elpaca-get id)))

(if-let* ((dependents (elpaca<-dependents e)))

(warn "%S previously queued as dependency of: %S" id dependents)

(warn "Duplicate item ID queued: %S" id))

(let* ((e (elpaca<-create order))

(q (or queue (car elpaca--queues))))

(when (memq id elpaca-ignored-dependencies)

(setq elpaca-ignored-dependencies (delq id elpaca-ignored-dependencies)))

(when queue (setf (elpaca<-queue-id e) (elpaca-q<-id q)

(elpaca<-init e) (elpaca-q<-type q)))

(setf (alist-get id (elpaca-q<-elpacas q)) e)

(elpaca--signal e nil 'queued)

e)))

;;;###autoload

(defun elpaca-split-queue (&rest args)

"Split remaining elpacas into new queue with ARGS."

(unless (elpaca-q<-elpacas (car elpaca--queues)) (pop elpaca--queues))

(push (apply #'elpaca-q<-create args) elpaca--queues)

nil)

;;;###autoload

(defmacro elpaca-queue (&rest body)

"Execute BODY in new queue."

(declare (debug t))

`(progn (elpaca-split-queue) ,@body (elpaca-split-queue)))

(defvar elpaca--post-queues-hook nil)

(defun elpaca--finalize-queue (q)

"Run Q's post installation functions:

- load cached autoloads, add info path loading logic,

- evaluate deferred package configuration forms

- possibly run `elpaca-after-init-hook'."

(when-let* ((autoloads (elpaca-q<-autoloads q)))

(condition-case-unless-debug err

(eval `(progn ,@(reverse autoloads)) t)

((error) (warn "Autoload Error: %S" err))))

(setf (elpaca-q<-status q) 'complete) ; Avoid loop when forms call elpaca-process-queue.

(when-let* ((forms (nreverse (elpaca-q<-forms q))))

(with-current-buffer (get-buffer-create " *elpaca--finalize-queue*")

(setq-local lexical-binding t)

(cl-loop for (id . body) in forms

do (condition-case-unless-debug err

(eval `(progn ,@body) t)

((error) (warn "Config Error %s: %S" id err)))))

(setf (elpaca-q<-forms q) nil))

(run-hooks 'elpaca-post-queue-hook)

(let ((next (nth (1+ (elpaca-q<-id q)) (reverse elpaca--queues))))

(unless (or elpaca-after-init-time ; Already run.

elpaca--waiting ; Won't know if final queue until after waiting.

(not (eq (elpaca-q<-type q) 'init)) ; Already run.

(and next (eq (elpaca-q<-type next) 'init))) ; More init queues.

(elpaca-split-queue)

(with-eval-after-load 'info

(info-initialize)

(cl-loop for (_id . e) in (elpaca--queued) do

(when-let* ((build (elpaca<-build-dir e))

(dir (expand-file-name "dir" build))

((file-exists-p dir))

((not (member build Info-directory-list))))

(push build Info-directory-list))))

(setq elpaca-after-init-time (current-time))

(run-hooks 'elpaca-after-init-hook))

(if (and next (elpaca-q<-elpacas next))

(elpaca--process-queue next)

(run-hooks 'elpaca--post-queues-hook))))

(defun elpaca--throttled-p (e)

"Return t if E is blocked due to `elpaca-queue-limit'."

(let ((statuses (elpaca<-statuses e)))

(and (eq (car statuses) 'blocked) (eq (cadr statuses) 'queue-throttled))))

(defun elpaca--finalize (e)

"Declare E finished or failed."

(unless (eq (elpaca--status e) 'failed)

(elpaca--signal

e (concat "✓ " (format-time-string "%s.%3N" (elpaca--log-duration e)) " secs")

'finished))

(let* ((q (elpaca--q e))

(es (elpaca-q<-elpacas q)))

(when-let* ((elpaca-queue-limit)

(next (cl-loop for (_ . e) in es thereis (and (elpaca--throttled-p e) e))))

(elpaca--signal next nil 'unthrottled)

(elpaca--continue-build next))

(when (= (cl-incf (elpaca-q<-processed q)) (length es)) (elpaca--finalize-queue q))))

(defun elpaca--propertize-subprocess (process)

"Propertize PROCESS according to exit status in associated E."

(when-let* ((e (process-get process :elpaca))

(entry (car (last (elpaca<-log e) (process-get process :loglen)))))

(setf (nth 2 entry) (propertize (nth 2 entry) 'face

(if (zerop (process-exit-status process))

'elpaca-finished 'elpaca-failed)))))

(defun elpaca--command-string (strings &optional prefix)

"Return string of form PREFIX STRINGS."

(concat (or prefix "$") (string-join strings " ")))

(defun elpaca--call-with-log (e verbosity &rest command)

"Call and Log E's COMMAND and output with VERBOSITY."

(elpaca-with-process (apply #'elpaca-process-call command)

(elpaca--signal e (propertize (elpaca--command-string command)

'face (if success 'elpaca-finished 'elpaca-failed))

nil nil verbosity)

(when-let* ((output (string-trim (concat stdout stderr)))

((not (string-empty-p output))))

(elpaca--signal e output nil nil verbosity))

result))

(defun elpaca--files (e &optional files nocons)

"Return alist of E :files to be symlinked: (PATH . TARGET PATH).

FILES and NOCONS are used recursively."

(cl-loop

with source-dir = (elpaca<-source-dir e)

with default-directory = source-dir

with build-dir = (elpaca<-build-dir e)

with recipe = (elpaca<-recipe e)

with files = (or files (if-let* ((member (plist-member recipe :files)))

(cadr member) elpaca-default-files-directive))

with (exclusions targets with-subdirs)

for el in files do

(pcase el

((pred stringp) (push (or (file-expand-wildcards el) el) targets))

(`(:exclude . ,excluded) (push (elpaca--files e excluded 'nocons) exclusions))

(:defaults (push (elpaca--files e elpaca-default-files-directive 'nocons) targets))

;;@FIX: subdir needn't be same name as globbed path...

(`(,_subdir . ,paths)

(cl-loop for path in paths

for expanded = (file-expand-wildcards path)

do (cl-loop for path in expanded

do (push (cons (expand-file-name path source-dir)

(expand-file-name path build-dir))

with-subdirs)))))

finally return

(let ((targets (cl-nset-difference (flatten-tree targets) (flatten-tree exclusions)

:test #'equal)))

(if nocons

targets

(append with-subdirs

(cl-loop for target in targets when (file-exists-p target)

collect (cons (expand-file-name target)

(expand-file-name (file-name-nondirectory target)

build-dir))))))))

(defun elpaca--find-source-file-maybe ()

"Find corresponding source file for `current-buffer'."

(when-let* ((file (buffer-file-name))

((string-prefix-p elpaca-builds-directory file))

(e (cdr (cl-find-if (lambda (bdir) (string-match-p bdir file))

(elpaca--queued)

:key (lambda (qd) (elpaca<-build-dir (cdr qd))))))

(source (car (rassoc file (elpaca--files e))))

((file-exists-p source)))

(find-alternate-file source)

(message "Found Elpaca build file source")))

;;;###autoload

(define-minor-mode elpaca-no-symlink-mode

"Global minor mode which installs build files by copying."

:global t :group 'elpaca

(if elpaca-no-symlink-mode

(add-hook 'find-file-hook #'elpaca--find-source-file-maybe)

(remove-hook 'find-file-hook #'elpaca--find-source-file-maybe)))

(defun elpaca-build-link (e)

"Link E's :files into its builds subdirectory."

(elpaca--signal e "Linking build files" 'linking)

(let* ((build-dir (elpaca<-build-dir e))

(files (or (elpaca<-files e)

(setf (elpaca<-files e) (elpaca--files e)))))

(when (file-exists-p build-dir) (delete-directory build-dir 'recursive))

(make-directory build-dir 'parents)

(dolist (spec files)

(when-let* ((file (car spec))

((file-exists-p file))

(link (cdr spec)))

(make-directory (file-name-directory link) 'parents)

(if elpaca-no-symlink-mode

(if (file-directory-p file)

(copy-directory file link nil 'parents 'recursive)

(copy-file file link 'overwrite))

(make-symbolic-link file link 'overwrite)))))

(setf (elpaca<-builtp e) t)

(elpaca--continue-build e "Build files linked"))

(defvar elpaca--eol (if (memq system-type '(ms-dos windows-nt cygwin)) "\r\n" "\n"))

(defun elpaca--process-filter (process output)

"Filter PROCESS OUTPUT."

(process-put process :raw-output (concat (process-get process :raw-output) output))

(let* ((e (process-get process :elpaca))

(parsed (process-get process :parsed))

(timer (process-get process :timer))

(chunk (concat parsed output))

(lines (split-string chunk elpaca--eol))

(linep (string-empty-p (car (last lines)))))

(when timer (cancel-timer timer))

(unless (eq (elpaca--status e) 'failed)

(process-put

process :timer (run-at-time elpaca-busy-interval nil #'elpaca--update-log-buffer)))

(unless linep

(process-put process :parsed (car (last lines)))

(setq lines (butlast lines)))

(dolist (line lines)

(unless (string-empty-p line)

(let ((escaped (replace-regexp-in-string "\033\\[[0-9;]*[a-zA-Z]" "" line)))

(elpaca--signal e (concat " " (car (last (split-string escaped "\r" t))))))))))

(defun elpaca--process-sentinel (&optional info status process event)

"Update E's INFO and STATUS when PROCESS EVENT is finished."

(if-let* ((e (process-get process :elpaca))

((and (equal event "finished\n") (not (eq (elpaca--status e) 'failed)))))

(progn (elpaca--propertize-subprocess process)

(elpaca--continue-build e info status))

(elpaca--fail e "Subprocess error (see previous log entries)")))

(defun elpaca-build-docs-process-sentinel (process event)

"Sentinel for info compilation PROCESS EVENT."

(let* ((e (process-get process :elpaca))

(finished (equal event "finished\n")))

(unless finished

(setf (elpaca<-build-steps e)

(cl-remove 'elpaca--install-info (elpaca<-build-steps e))))

(elpaca--propertize-subprocess process)

(elpaca--continue-build

e (if finished "Info compiled" (concat "Compilation failure: " (string-trim event))))))

(defun elpaca--make-process (e &rest spec)

"Attach process to E from `make-process' SPEC plist."

(declare (indent 1))

(let* ((command (plist-get spec :command))

(_ (elpaca--signal ;;@HACK Signal before process started. SIGSTP/SIGSTOP failed orders.

e (propertize (elpaca--command-string command) 'face 'elpaca-blocked)))

(process (make-process ;;@FIX: Find way to stop process and continue after bookkeeping

:name (concat "elpaca-" (plist-get spec :name) "-" (elpaca<-package e))

:connection-type (or (plist-get spec :connection-type) 'pipe)

:command command

:filter (or (plist-get spec :filter) #'elpaca--process-filter)

:sentinel

(lambda (process event)

(condition-case err

(funcall (plist-get spec :sentinel) process event)

(elpaca-build-error (elpaca--handle-build-error e err)))))))

(process-put process :elpaca e)

(process-put process :loglen (length (elpaca<-log e)))

(setf (elpaca<-process e) process)))

(defcustom elpaca-with-emacs-env-form

'(setq gc-cons-percentage 1.0 print-level nil print-circle nil)

"Form evaluated by `elpaca-with-emacs' subprocesses.

Used to modify the subprocess environment."

:type 'sexp)

;;;###autoload

(defmacro elpaca-with-emacs (e &optional args &rest forms)

"Execute E's FORMS in an async Emacs subprocess with ARGS.