backpack.el
1 ;; -*- lexical-binding: t; -*- 2 3 (eval-and-compile 4 (when (version< emacs-version "29.1") 5 (error "Backpack is only compatible with Emacs version 29.1 and up"))) 6 7 (let ((old-version (eval-when-compile emacs-version))) 8 (unless (string= emacs-version old-version) 9 (user-error (format "Backpack was compiled with Emacs %s, but was loaded with %s" emacs-version old-version)))) 10 11 ;; Copy the consistency imposed by Doom Emacs 12 (when (bound-and-true-p module-file-suffix) 13 (push 'dynamic-modules features)) 14 (when (fboundp #'json-parse-string) 15 (push 'jansson features)) 16 (when (string-match-p "HARFBUZZ" system-configuration-features) 17 (push 'harfbuzz features)) 18 19 ;; don't bother with native compilation if it's not functional 20 (when (and (featurep 'native-compile) 21 (not (native-comp-available-p))) 22 (delq 'native-compile features)) 23 24 ;; don't worry the user about obsolete macros 25 (put 'if-let 'byte-obsolete-info nil) 26 (put 'when-let 'byte-obsolete-info nil) 27 28 ;; backpack standard library 29 (add-to-list 'load-path (expand-file-name "base-packages/leaf.el" user-emacs-directory)) 30 (add-to-list 'load-path (expand-file-name "base-packages/leaf-keywords.el" user-emacs-directory)) 31 (add-to-list 'load-path (file-name-directory load-file-name)) 32 (require 'leaf) 33 (require 'leaf-keywords) 34 (require 'backpack-pouch) 35 (require 'backpack-email-utils) 36 37 (leaf-keywords-init) 38 39 ;;; add additional keywords to leaf block 40 ;; :doctor defines binaries to check on the user's system 41 ;; :fonts check what if the fonts needed by a package are installed 42 (plist-put leaf-keywords :doctor '`(,@leaf--body)) 43 (plist-put leaf-keywords :fonts '`(,@leaf--body)) 44 45 ;; Packages that should be activated even in sync mode 46 ;; This is useful for packages like treesit-auto that need to be active 47 ;; during sync to install tree-sitter grammars 48 (defvar backpack--enable-on-sync-packages nil 49 "List of package symbols that should be activated even in sync mode.") 50 51 (defmacro backpack-enable-on-sync! (&rest packages) 52 "Mark PACKAGES to be activated even in sync mode. 53 Call this macro BEFORE the leaf declaration for packages that need 54 to be active during sync (e.g., for installing tree-sitter grammars). 55 56 Example: 57 (backpack-enable-on-sync! treesit-auto) 58 (leaf treesit-auto 59 :ensure t 60 :config ...)" 61 `(dolist (pkg ',packages) 62 (cl-pushnew pkg backpack--enable-on-sync-packages))) 63 64 (defun backpack--activate-package (package-name) 65 "Manually activate PACKAGE-NAME by loading its autoloads. 66 This is used in sync mode for packages marked with `backpack-enable-on-sync!'." 67 (let* ((build-dir (expand-file-name (symbol-name package-name) elpaca-builds-directory)) 68 (autoloads-file (expand-file-name 69 (format "%s-autoloads.el" package-name) 70 build-dir))) 71 (if (not (file-exists-p build-dir)) 72 (message "Backpack: WARNING - build dir for %s does not exist" package-name) 73 (add-to-list 'load-path build-dir) 74 (if (not (file-exists-p autoloads-file)) 75 (message "Backpack: WARNING - autoloads for %s not found" package-name) 76 (load autoloads-file nil t) 77 ;; Also require the package to ensure it's fully loaded 78 (condition-case err 79 (require package-name) 80 (error 81 (message "Backpack: Failed to require %s: %S" package-name err))))))) 82 83 (defun backpack--activate-enable-on-sync-packages () 84 "Activate all packages marked with `backpack-enable-on-sync!'. 85 This should be called after packages are built but before their config runs." 86 (dolist (pkg backpack--enable-on-sync-packages) 87 (message "Backpack: Activating package for sync: %s" pkg) 88 (backpack--activate-package pkg))) 89 90 ;; alias :ensure to :elpaca 91 (setq leaf-alias-keyword-alist '((:ensure . :elpaca))) 92 93 ;;; Backpack mode management 94 ;; NOTE: This must be defined BEFORE the leaf advice below 95 (defvar backpack-mode 'normal 96 "Current operating mode for Backpack. 97 Possible values: 98 - `normal': Standard Emacs startup - only activate pre-built packages 99 - `sync': Synchronization mode - install/build packages but skip activation") 100 101 (defun backpack-sync-mode-p () 102 "Return non-nil if Backpack is in synchronization mode." 103 (eq backpack-mode 'sync)) 104 105 (defun backpack-normal-mode-p () 106 "Return non-nil if Backpack is in normal mode." 107 (eq backpack-mode 'normal)) 108 109 ;; NOTE: We previously tried to advise the `leaf` macro to filter keywords in sync mode, 110 ;; but `leaf` is a macro, not a function, so `:around` advice doesn't work properly. 111 ;; Instead, we rely on the elpaca advice (backpack--elpaca-skip-forms-in-sync-mode) 112 ;; to prevent configuration forms from running during sync mode. 113 114 ;;; Tree-sitter language management 115 (defvar backpack--treesit-langs nil 116 "List of tree-sitter language symbols that are needed by enabled gears. 117 This is populated by `backpack-treesit-langs!' calls in gear files.") 118 119 (defmacro backpack-treesit-langs! (&rest langs) 120 "Declare that the current gear needs tree-sitter support for LANGS. 121 LANGS should be symbols like `go', `python', `json', etc. 122 These will be added to `treesit-auto-langs' and installed during sync." 123 `(dolist (lang ',langs) 124 (cl-pushnew lang backpack--treesit-langs))) 125 126 (defun backpack--install-treesit-grammars () 127 "Install all tree-sitter grammars declared by enabled gears. 128 This should be called during sync mode after all gears are loaded. 129 Requires treesit-auto to be activated (via `backpack-enable-on-sync!')." 130 (when (and backpack--treesit-langs 131 (not (gearp! :ui -treesit))) 132 (message "Backpack: Installing tree-sitter grammars for: %s" 133 (mapconcat #'symbol-name backpack--treesit-langs ", ")) 134 135 ;; treesit-auto should already be loaded via backpack-enable-on-sync! 136 (if (not (boundp 'treesit-auto-recipe-list)) 137 (message "Backpack: treesit-auto not available, skipping grammar installation") 138 ;; Set treesit-auto-langs to only the languages we need 139 (setq treesit-auto-langs backpack--treesit-langs) 140 ;; Set install location 141 (setq treesit-extra-load-path (list backpack-tree-sitter-installation-dir)) 142 ;; Make sure the installation directory exists 143 (make-directory backpack-tree-sitter-installation-dir t) 144 ;; Build the source alist from treesit-auto recipes 145 (let ((treesit-language-source-alist (treesit-auto--build-treesit-source-alist)) 146 (treesit-auto-install t) ; Install without prompting 147 (installed 0) 148 (failed 0)) 149 (dolist (lang backpack--treesit-langs) 150 (condition-case err 151 (let ((source (alist-get lang treesit-language-source-alist))) 152 (if (not source) 153 (progn 154 (message "Backpack: No recipe found for %s, skipping" lang) 155 (cl-incf failed)) 156 (message "Backpack: Installing grammar for %s..." lang) 157 (treesit-install-language-grammar lang backpack-tree-sitter-installation-dir) 158 (cl-incf installed))) 159 (error 160 (message "Backpack: Failed to install grammar for %s: %s" lang err) 161 (cl-incf failed)))) 162 (message "Backpack: Tree-sitter grammars: %d installed, %d failed/skipped" 163 installed failed))))) 164 165 (defconst backpack-system 166 (pcase system-type 167 ('darwin '(macos bsd)) 168 ((or 'cygwin 'windows-nt 'ms-dos) '(windows)) 169 ((or 'gnu 'gnu/linux) '(gnu)) 170 ((or 'gnu/kfreebsd 'berkeley-unix) '(gnu bsd)) 171 ('android '(android))) 172 "The operating system Emacs is running on.") 173 174 (defconst backpack--system-windows-p (eq 'windows (car backpack-system))) 175 (defconst backpack--system-macos-p (eq 'macos (car backpack-system))) 176 (defconst backpack--system-gnu-p (eq 'gnu (car backpack-system))) 177 178 (when (and backpack--system-gnu-p 179 (getenv-internal "WSLENV")) 180 (add-to-list 'backpack-system 'wsl 'append)) 181 182 (defconst backpack--system-wsl-p (memq 'wsl backpack-system) 183 "Non-nil when Emacs is running inside Windows Subsystem for Linux.") 184 185 (push :system features) 186 (put :system 'subfeatures backpack-system) 187 188 (when backpack--system-windows-p 189 (when-let* ((realhome 190 (and (null (getenv-internal "HOME")) 191 (getenv "USERPROFILE")))) 192 (setenv "HOME" realhome) 193 (setq abbreviated-home-dir nil))) 194 195 ;;; Globals 196 197 (defgroup backpack nil 198 "A self-documenting GNU Emacs starter kit inspired after Bedrock and Doom." 199 :link '(url-link "https://github.com/shackra/backpack")) 200 201 (defvar backpack-emacs-dir user-emacs-directory 202 "The path of the currently loaded Emacs configuration.") 203 204 (defconst backpack-core-dir (file-name-directory load-file-name) 205 "The directory of Backpack files.") 206 207 (defvar backpack-user-dir 208 (let ((in-xdg-config (expand-file-name "backpack/" (getenv-internal "XDG_CONFIG_HOME"))) 209 (in-user-home "~/.backpack.d/")) 210 (if (file-exists-p in-user-home) 211 in-user-home 212 in-xdg-config)) 213 "Location of the user's private configuration. 214 215 Either ~/.config/backpack or ~/.backpack.d/.") 216 217 (defvar backpack-cache-dir (expand-file-name ".cache/" backpack-emacs-dir) 218 "Location for local storage") 219 220 (defvar backpack-data-dir 221 (expand-file-name "etc" backpack-cache-dir) 222 "Location use by Backpack to store important files. 223 224 Delete this directory entails user intervention to make things work 225 again.") 226 227 (defvar backpack-nonessential-dir 228 (expand-file-name "nonessentials" backpack-cache-dir) 229 "Location where Backpack stores nonessential files. 230 231 If anything is missing here, Backpack Emacs will work as normal.") 232 233 (defvar backpack-state-dir 234 (expand-file-name "state" backpack-cache-dir) 235 "Location for files that carry state for some functionalities or packages.") 236 237 (defvar backpack-tree-sitter-installation-dir 238 (expand-file-name "tree-sitter" backpack-nonessential-dir) 239 "Location for treesit to install compiled grammar.") 240 241 ;; 242 ;;; Startup optimizations 243 ;;; copied straight from Doom Emacs 👀 244 245 (unless (daemonp) 246 ;; PERF: `file-name-handler-alist' is consulted on each call to `require', 247 ;; `load', or various file/io functions (like `expand-file-name' or 248 ;; `file-remote-p'). You get a noteable boost to startup time by unsetting 249 ;; or simplifying its value. 250 (let ((old-value (default-toplevel-value 'file-name-handler-alist))) 251 (set-default-toplevel-value 252 'file-name-handler-alist 253 ;; HACK: The elisp libraries bundled with Emacs are either compressed or 254 ;; not, never both. So if calc-loaddefs.el.gz exists, calc-loaddefs.el 255 ;; won't, and vice versa. This heuristic is used to guess the state of 256 ;; all other built-in (or site); if they're compressed, we must leave the 257 ;; gzip file handler in `file-name-handler-alist' so Emacs knows how to 258 ;; load them. Otherwise, we can omit it (at least during startup) for a 259 ;; boost in package load time. 260 (if (eval-when-compile 261 (locate-file-internal "calc-loaddefs.el" load-path)) 262 nil 263 (list (rassq 'jka-compr-handler old-value)))) 264 ;; Remember it so it can be reset where needed. 265 (put 'file-name-handler-alist 'initial-value old-value) 266 ;; COMPAT: Eventually, Emacs will process any files passed to it via the 267 ;; command line, and will do so *really* early in the startup process. 268 ;; These might contain special file paths like TRAMP paths, so restore 269 ;; `file-name-handler-alist' just for this portion of startup. 270 (define-advice command-line-1 (:around (fn args-left) respect-file-handlers) 271 (let ((file-name-handler-alist (if args-left old-value file-name-handler-alist))) 272 (funcall fn args-left))) 273 ;; COMPAT: ...but restore `file-name-handler-alist' later, because it is 274 ;; needed for handling encrypted or compressed files, among other things. 275 (add-hook 'emacs-startup-hook 276 (defun backpack--reset-file-handler-alist-h () 277 (set-default-toplevel-value 278 'file-name-handler-alist 279 ;; Merge instead of overwrite because there may have been changes to 280 ;; `file-name-handler-alist' since startup we want to preserve. 281 (delete-dups (append file-name-handler-alist old-value)))) 282 100)) 283 284 (unless noninteractive 285 ;; PERF: Resizing the Emacs frame (to accommodate fonts that are smaller or 286 ;; larger than the default system font) can impact startup time 287 ;; dramatically. The larger the delta, the greater the delay. Even trivial 288 ;; deltas can yield up to a ~1000ms loss, depending also on 289 ;; `window-system' (PGTK builds seem least affected and NS/MAC the most). 290 (setq frame-inhibit-implied-resize t) 291 292 ;; PERF: A fair bit of startup time goes into initializing the splash and 293 ;; scratch buffers in the typical Emacs session (b/c they activate a 294 ;; non-trivial major mode, generate the splash buffer, and trigger 295 ;; premature frame redraws by writing to *Messages*). These hacks prevent 296 ;; most of this work from happening for some decent savings in startup 297 ;; time. Our dashboard and `doom/open-scratch-buffer' provide a faster 298 ;; (and more useful) alternative anyway. 299 (setq inhibit-startup-screen t 300 inhibit-startup-echo-area-message user-login-name 301 initial-major-mode 'fundamental-mode 302 initial-scratch-message nil) 303 ;; PERF,UX: Prevent "For information about GNU Emacs..." line in *Messages*. 304 (advice-add #'display-startup-echo-area-message :override #'ignore) 305 ;; PERF: Suppress the vanilla startup screen completely. We've disabled it 306 ;; with `inhibit-startup-screen', but it would still initialize anyway. 307 ;; This involves file IO and/or bitmap work (depending on the frame type) 308 ;; that we can no-op for a free 50-100ms saving in startup time. 309 (advice-add #'display-startup-screen :override #'ignore) 310 311 (unless initial-window-system 312 ;; PERF: `tty-run-terminal-initialization' can take 2-3s when starting up 313 ;; TTY Emacs (non-daemon sessions), depending on your TERM, TERMINFO, 314 ;; and TERMCAP, but this work isn't very useful on modern systems (the 315 ;; type I expect Doom's users to be using). The function seems less 316 ;; expensive if run later in the startup process, so I defer it. 317 ;; REVIEW: This may no longer be needed in 29+. Needs testing! 318 (define-advice tty-run-terminal-initialization (:override (&rest _) defer) 319 (advice-remove #'tty-run-terminal-initialization #'tty-run-terminal-initialization@defer) 320 (add-hook 'window-setup-hook 321 (apply-partially #'tty-run-terminal-initialization 322 (selected-frame) nil t)))) 323 324 ;; These optimizations are brittle, difficult to debug, and obscure other 325 ;; issues, so bow out when debug mode is on. 326 (unless init-file-debug 327 ;; PERF: The mode-line procs a couple dozen times during startup, before 328 ;; the user even sees the first mode-line. This is normally fast, but we 329 ;; can't predict what the user (or packages) will put into the 330 ;; mode-line. Also, mode-line packages have a bad habit of throwing 331 ;; performance to the wind, so best we just disable the mode-line until 332 ;; we can see one. 333 (put 'mode-line-format 'initial-value (default-toplevel-value 'mode-line-format)) 334 (setq-default mode-line-format nil) 335 (dolist (buf (buffer-list)) 336 (with-current-buffer buf (setq mode-line-format nil))) 337 ;; PERF,UX: Premature redisplays/redraws can substantially affect startup 338 ;; times and/or flash a white/unstyled Emacs frame during startup, so I 339 ;; try real hard to suppress them until we're sure the session is ready. 340 (setq-default inhibit-redisplay t 341 inhibit-message t) 342 ;; COMPAT: If the above vars aren't reset, Emacs could appear frozen or 343 ;; garbled after startup (or in case of an startup error). 344 (defun backpack--reset-inhibited-vars-h () 345 (setq-default inhibit-redisplay nil 346 inhibit-message nil) 347 (remove-hook 'post-command-hook #'backpack--reset-inhibited-vars-h)) 348 (add-hook 'post-command-hook #'backpack--reset-inhibited-vars-h -100)) 349 350 ;; PERF: Doom disables the UI elements by default, so that there's less for 351 ;; the frame to initialize. However, `tool-bar-setup' is still called and 352 ;; it does some non-trivial work to set up the toolbar before we can 353 ;; disable it. To side-step this work, I disable the function and call it 354 ;; later (see `startup--load-user-init-file@undo-hacks'). 355 (advice-add #'tool-bar-setup :override #'ignore) 356 357 ;; PERF,UX: site-lisp files are often obnoxiously noisy (emitting output 358 ;; that isn't useful to end-users, like load messages, deprecation 359 ;; notices, and linter warnings). Displaying these in the minibuffer 360 ;; causes unnecessary redraws at startup which can impact startup time 361 ;; drastically and cause flashes of white. It also pollutes the logs. I 362 ;; suppress it here and load it myself, later, in a more controlled way 363 ;; (see `doom-initialize'). 364 (put 'site-run-file 'initial-value site-run-file) 365 (setq site-run-file nil) 366 367 (define-advice startup--load-user-init-file (:around (fn &rest args) undo-hacks 95) 368 "Undo Doom's startup optimizations to prep for the user's session." 369 (unwind-protect (apply fn args) 370 ;; Now it's safe to be verbose. 371 (setq-default inhibit-message nil) 372 ;; COMPAT: Once startup is sufficiently complete, undo our earlier 373 ;; optimizations to reduce the scope of potential edge cases. 374 (advice-remove #'tool-bar-setup #'ignore) 375 376 (add-hook 'tool-bar-mode-hook (defun --tool-bar-setup () 377 (tool-bar-setup) 378 (remove-hook 'tool-bar-mode-hook '--tool-bar-setup))) 379 (unless (default-toplevel-value 'mode-line-format) 380 (setq-default mode-line-format (get 'mode-line-format 'initial-value))))) 381 382 ;; PERF: Unset a non-trivial list of command line options that aren't 383 ;; relevant to this session, but `command-line-1' still processes. 384 (unless backpack--system-macos-p 385 (setq command-line-ns-option-alist nil)) 386 (unless (memq initial-window-system '(x pgtk)) 387 (setq command-line-x-option-alist nil)))) 388 389 ;; 390 ;;; Reasonable, global defaults 391 392 ;;; CLI settings 393 (when noninteractive 394 ;; Don't generate superfluous files when writing temp buffers. 395 (setq make-backup-files nil) 396 ;; Stop user config from interfering with elisp shell scripts. 397 (setq enable-dir-local-variables nil) 398 ;; Reduce ambiguity, embrace specificity, enjoy predictability. 399 (setq case-fold-search nil) 400 ;; Don't clog the user's trash with our CLI refuse. 401 (setq delete-by-moving-to-trash nil)) 402 403 ;;; Don't litter `doom-emacs-dir'/$HOME 404 ;; HACK: I change `user-emacs-directory' because many packages (even built-in 405 ;; ones) abuse it to build paths for storage/cache files (instead of correctly 406 ;; using `locate-user-emacs-file'). This change ensures that said data files 407 ;; are never saved to the root of your emacs directory *and* saves us the 408 ;; trouble of setting a million directory/file variables. 409 (setq user-emacs-directory backpack-cache-dir) 410 411 ;; ...However, this may surprise packages (and users) that read 412 ;; `user-emacs-directory' expecting to find the location of your Emacs config, 413 ;; such as server.el! 414 (setq server-auth-dir (file-name-concat backpack-emacs-dir "server/")) 415 416 ;; Packages with file/dir settings that don't use `user-emacs-directory' or 417 ;; `locate-user-emacs-file' to initialize will need to set explicitly, to stop 418 ;; them from littering in ~/.emacs.d/. 419 (setq desktop-dirname (file-name-concat backpack-state-dir "desktop") 420 pcache-directory (file-name-concat backpack-cache-dir "pcache/")) 421 422 ;; Allow the user to store custom.el-saved settings and themes in their Doom 423 ;; config (e.g. ~/.doom.d/). 424 (setq custom-file (file-name-concat backpack-user-dir "custom.el")) 425 426 ;; backup all files here 427 (setq backup-directory-alist `(("." . ,backpack-nonessential-dir))) 428 429 (define-advice en/disable-command (:around (fn &rest args) write-to-data-dir) 430 "Save safe-local-variables to `custom-file' instead of `user-init-file'. 431 432 Otherwise, `en/disable-command' (in novice.el.gz) is hardcoded to write them to 433 `user-init-file')." 434 (let ((user-init-file custom-file)) 435 (apply fn args))) 436 437 ;;; Native compilation support (see http://akrl.sdf.org/gccemacs.html) 438 (when (boundp 'native-comp-eln-load-path) 439 ;; Don't store eln files in ~/.emacs.d/eln-cache (where they can easily be 440 ;; deleted by 'doom upgrade'). 441 ;; REVIEW: Advise `startup-redirect-eln-cache' when 28 support is dropped. 442 (add-to-list 'native-comp-eln-load-path (expand-file-name "eln/" backpack-cache-dir)) 443 444 ;; UX: Suppress compiler warnings and don't inundate users with their popups. 445 ;; They are rarely more than warnings, so are safe to ignore. 446 (setq native-comp-async-report-warnings-errors init-file-debug 447 native-comp-warning-on-missing-source init-file-debug) 448 449 ;; HACK: `native-comp-deferred-compilation-deny-list' is replaced in later 450 ;; versions of Emacs 29, and with no deprecation warning. I alias them to 451 ;; ensure backwards compatibility for packages downstream that may have not 452 ;; caught up yet. I avoid marking it obsolete because obsolete warnings are 453 ;; unimportant to end-users. It's the package devs that should be informed. 454 (unless (boundp 'native-comp-deferred-compilation-deny-list) 455 (defvaralias 'native-comp-deferred-compilation-deny-list 'native-comp-jit-compilation-deny-list)) 456 457 ;; UX: By default, native-comp uses 100% of half your cores. If you're 458 ;; expecting this this should be no issue, but the sudden (and silent) spike 459 ;; of CPU and memory utilization can alarm folks, overheat laptops, or 460 ;; overwhelm less performant systems. 461 (define-advice comp-effective-async-max-jobs (:before (&rest _) set-default-cpus) 462 "Default to 1/4 of cores in interactive sessions and all of them otherwise." 463 (and (null comp-num-cpus) 464 (zerop native-comp-async-jobs-number) 465 (setq comp-num-cpus 466 (max 1 (/ (num-processors) (if noninteractive 1 4)))))) 467 468 (define-advice comp-run-async-workers (:around (fn &rest args) dont-litter-tmpdir) 469 "Normally, native-comp writes a ton to /tmp. This advice forces it to write 470 to `doom-profile-cache-dir' instead, so it can be safely cleaned up as part of 471 'doom sync' or 'doom gc'." 472 (let ((temporary-file-directory (expand-file-name "comp/" backpack-cache-dir))) 473 (make-directory temporary-file-directory t) 474 (apply fn args))) 475 476 (with-eval-after-load 'comp 477 ;; HACK: On Emacs 30.0.92, `native-comp-jit-compilation-deny-list' was moved 478 ;; to comp-run. See emacsmirror/emacs@e6a955d24268. Doom forces straight 479 ;; to consult this variable when building packages. 480 (require 'comp-run nil t) 481 ;; HACK: Disable native-compilation for some troublesome packages 482 (mapc (apply-partially #'add-to-list 'native-comp-deferred-compilation-deny-list) 483 (list "/seq-tests\\.el\\'" 484 "/emacs-jupyter.*\\.el\\'" 485 "/evil-collection-vterm\\.el\\'" 486 "/vterm\\.el\\'" 487 "/with-editor\\.el\\'")))) 488 489 490 ;;; Reduce unnecessary/unactionable warnings/logs 491 ;; Disable warnings from the legacy advice API. They aren't actionable or 492 ;; useful, and often come from third party packages. 493 (setq ad-redefinition-action 'accept) 494 495 ;; Ignore warnings about "existing variables being aliased". Otherwise the user 496 ;; gets very intrusive popup warnings about our (intentional) uses of 497 ;; defvaralias, which are done because ensuring aliases are created before 498 ;; packages are loaded is an unneeded and unhelpful maintenance burden. Emacs 499 ;; still aliases them fine regardless. 500 (setq warning-suppress-types '((defvaralias) (lexical-binding))) 501 502 ;; As some point in 31+, Emacs began spamming the user with warnings about 503 ;; missing `lexical-binding' cookies in elisp files that you are unlikely to 504 ;; have any direct control over (e.g. package files, data lisp files, and elisp 505 ;; shell scripts). This shuts it up. 506 (setq warning-inhibit-types '((files missing-lexbind-cookie))) 507 508 ;; Reduce debug output unless we've asked for it. 509 (setq debug-on-error init-file-debug 510 jka-compr-verbose init-file-debug) 511 512 ;;; Stricter security defaults 513 ;; Emacs is essentially one huge security vulnerability, what with all the 514 ;; dependencies it pulls in from all corners of the globe. Let's try to be a 515 ;; *little* more discerning. 516 (setq gnutls-verify-error noninteractive 517 gnutls-algorithm-priority 518 (when (boundp 'libgnutls-version) 519 (concat "SECURE128:+SECURE192:-VERS-ALL" 520 (if (and (not backpack--system-windows-p) 521 (>= libgnutls-version 30605)) 522 ":+VERS-TLS1.3") 523 ":+VERS-TLS1.2")) 524 ;; `gnutls-min-prime-bits' is set based on recommendations from 525 ;; https://www.keylength.com/en/4/ 526 gnutls-min-prime-bits 3072 527 tls-checktrust gnutls-verify-error 528 ;; Emacs is built with gnutls.el by default, so `tls-program' won't 529 ;; typically be used, but in the odd case that it does, we ensure a more 530 ;; secure default for it (falling back to `openssl' if absolutely 531 ;; necessary). See https://redd.it/8sykl1 for details. 532 tls-program '("openssl s_client -connect %h:%p -CAfile %t -nbio -no_ssl3 -no_tls1 -no_tls1_1 -ign_eof" 533 "gnutls-cli -p %p --dh-bits=3072 --ocsp --x509cafile=%t \ 534 --strict-tofu --priority='SECURE192:+SECURE128:-VERS-ALL:+VERS-TLS1.2:+VERS-TLS1.3' %h" 535 ;; compatibility fallbacks 536 "gnutls-cli -p %p %h")) 537 538 539 ;;; Package managers 540 ;; Since Emacs 27, package initialization occurs before `user-init-file' is 541 ;; loaded, but after `early-init-file'. Doom handles package initialization, so 542 ;; we must prevent Emacs from doing it again. 543 (setq package-enable-at-startup nil) 544 545 ;; 546 ;;; Initializers 547 548 (defvar elpaca-installer-version 0.11) 549 (defvar elpaca-directory (expand-file-name "elpaca/" backpack-nonessential-dir)) 550 (defvar elpaca-builds-directory (expand-file-name "builds/" elpaca-directory)) 551 (defvar elpaca-repos-directory (expand-file-name "repos/" elpaca-directory)) 552 553 ;; Location of elpaca in base-packages (bundled with Backpack) 554 (defvar backpack--elpaca-source-dir 555 (expand-file-name "base-packages/elpaca/" backpack-emacs-dir) 556 "Location of the bundled elpaca source in base-packages.") 557 558 ;; Custom build steps for synchronization mode - everything except activation 559 (defvar backpack--sync-build-steps 560 '(elpaca--clone 561 elpaca--configure-remotes 562 elpaca--checkout-ref 563 elpaca--run-pre-build-commands 564 elpaca--queue-dependencies 565 elpaca--check-version 566 elpaca--link-build-files 567 elpaca--generate-autoloads-async 568 elpaca--byte-compile 569 elpaca--compile-info 570 elpaca--install-info 571 elpaca--add-info-path 572 elpaca--run-post-build-commands) 573 "Build steps for sync mode - excludes `elpaca--activate-package'.") 574 575 ;; Steps for activating pre-built packages in normal mode 576 (defvar backpack--activation-only-steps 577 '(elpaca--queue-dependencies elpaca--add-info-path elpaca--activate-package) 578 "Steps for normal mode - only activate already-built packages.") 579 580 (defun backpack--copy-directory-recursively (source dest) 581 "Copy SOURCE directory recursively to DEST using pure Emacs Lisp. 582 This is platform-agnostic and doesn't rely on external tools." 583 (unless (file-exists-p dest) 584 (make-directory dest t)) 585 (dolist (file (directory-files source t "^[^.]")) 586 (let ((dest-file (expand-file-name (file-name-nondirectory file) dest))) 587 (cond 588 ((file-directory-p file) 589 (backpack--copy-directory-recursively file dest-file)) 590 (t 591 (copy-file file dest-file t)))))) 592 593 (defun backpack--elpaca-repo-dir () 594 "Return the elpaca repo directory path." 595 (expand-file-name "elpaca/" elpaca-repos-directory)) 596 597 (defun backpack--elpaca-build-dir () 598 "Return the elpaca build directory path." 599 (expand-file-name "elpaca/" elpaca-builds-directory)) 600 601 (defun backpack--elpaca-installed-p () 602 "Return non-nil if elpaca is already installed in the expected location." 603 (let ((repo-dir (backpack--elpaca-repo-dir))) 604 (and (file-exists-p repo-dir) 605 (file-exists-p (expand-file-name "elpaca.el" repo-dir))))) 606 607 (defun backpack--install-elpaca-from-base-packages () 608 "Copy elpaca from base-packages to elpaca-repos-directory. 609 This uses the bundled elpaca instead of cloning from the internet." 610 (let ((repo-dir (backpack--elpaca-repo-dir))) 611 (message "Backpack: Installing elpaca from base-packages...") 612 ;; Ensure parent directories exist 613 (make-directory elpaca-repos-directory t) 614 ;; Copy elpaca source to repo directory 615 (backpack--copy-directory-recursively backpack--elpaca-source-dir repo-dir) 616 (message "Backpack: Elpaca source copied to %s" repo-dir))) 617 618 (defun backpack--build-elpaca () 619 "Build elpaca: byte-compile and generate autoloads. 620 This replicates what the elpaca installer does but without cloning." 621 (let* ((repo-dir (backpack--elpaca-repo-dir)) 622 (build-dir (backpack--elpaca-build-dir)) 623 (default-directory repo-dir)) 624 (message "Backpack: Building elpaca...") 625 626 ;; Byte-compile elpaca 627 (let ((emacs-exe (concat invocation-directory invocation-name))) 628 (call-process emacs-exe nil nil nil 629 "-Q" "-L" "." "--batch" 630 "--eval" "(byte-recompile-directory \".\" 0 'force)")) 631 632 ;; Load elpaca to generate autoloads 633 (add-to-list 'load-path repo-dir) 634 (require 'elpaca) 635 (elpaca-generate-autoloads "elpaca" repo-dir) 636 637 ;; Create build directory with symlinks/copies to repo 638 ;; Link all .el and .elc files including autoloads 639 (make-directory build-dir t) 640 (dolist (file (directory-files repo-dir t "\\.elc?\\'")) 641 (let ((dest (expand-file-name (file-name-nondirectory file) build-dir))) 642 (unless (file-exists-p dest) 643 (if (fboundp 'make-symbolic-link) 644 (condition-case nil 645 (make-symbolic-link file dest) 646 (error (copy-file file dest t))) 647 (copy-file file dest t))))) 648 649 (message "Backpack: Elpaca built successfully"))) 650 651 (defun backpack--ensure-elpaca () 652 "Ensure elpaca is installed and built from base-packages. 653 In sync mode, this will copy and build elpaca if needed. 654 In normal mode, this just loads elpaca if it's already built." 655 (let ((repo-dir (backpack--elpaca-repo-dir)) 656 (build-dir (backpack--elpaca-build-dir))) 657 658 (cond 659 ;; Elpaca is already built - just load it 660 ((and (file-exists-p build-dir) 661 (file-exists-p (expand-file-name "elpaca-autoloads.el" build-dir))) 662 (add-to-list 'load-path build-dir) 663 (require 'elpaca-autoloads nil t)) 664 665 ;; Elpaca source exists but not built - build it (sync mode) 666 ((and (backpack-sync-mode-p) 667 (backpack--elpaca-installed-p)) 668 (backpack--build-elpaca) 669 (add-to-list 'load-path build-dir) 670 (require 'elpaca-autoloads nil t)) 671 672 ;; Elpaca not installed - install from base-packages (sync mode only) 673 ((backpack-sync-mode-p) 674 (backpack--install-elpaca-from-base-packages) 675 (backpack--build-elpaca) 676 (add-to-list 'load-path build-dir) 677 (require 'elpaca-autoloads nil t)) 678 679 ;; Normal mode but elpaca not installed - try to load from repo 680 ((file-exists-p repo-dir) 681 (add-to-list 'load-path repo-dir) 682 (when (file-exists-p (expand-file-name "elpaca-autoloads.el" repo-dir)) 683 (load (expand-file-name "elpaca-autoloads.el" repo-dir) nil t))) 684 685 ;; Nothing available 686 (t 687 (when (backpack-normal-mode-p) 688 (display-warning 'backpack 689 "Elpaca is not installed. Run 'backpack ensure' first." 690 :error)))))) 691 692 (defun backpack--ref-needs-update-p (repo-dir requested-ref) 693 "Return non-nil if REPO-DIR's HEAD doesn't match REQUESTED-REF. 694 REQUESTED-REF can be a commit hash, tag, or branch name. 695 Uses `elpaca-process-call' for cross-platform git invocation." 696 (when (and repo-dir requested-ref (file-exists-p repo-dir)) 697 (let ((default-directory repo-dir)) 698 (condition-case nil 699 (let ((current-rev (string-trim 700 (cadr (elpaca-process-call "git" "rev-parse" "HEAD"))))) 701 ;; Check if requested-ref is a full commit hash that matches current 702 (not (or (string-prefix-p requested-ref current-rev) 703 (string-prefix-p current-rev requested-ref) 704 ;; Also try resolving the ref in case it's a tag or branch 705 (let ((resolved (elpaca-process-call "git" "rev-parse" requested-ref))) 706 (and (eq (car resolved) 0) 707 (string= current-rev 708 (string-trim (cadr resolved)))))))) 709 (error t))))) ; If there's an error, assume update is needed 710 711 (defun backpack--recipe-force-rebuild-on-ref-change (recipe) 712 "Modify RECIPE to force rebuild if the ref has changed. 713 In sync mode, checks if the requested :ref differs from the currently 714 checked out commit. If so, returns build steps that include fetch, 715 checkout, and rebuild operations." 716 (when (backpack-sync-mode-p) 717 (let* ((package (plist-get recipe :package)) 718 (requested-ref (plist-get recipe :ref)) 719 (repo-dir (when package 720 (expand-file-name package elpaca-repos-directory)))) 721 (when (and requested-ref 722 (backpack--ref-needs-update-p repo-dir requested-ref)) 723 (message "Backpack: Ref changed for '%s', will fetch and rebuild" package) 724 ;; Return build steps that fetch, checkout new ref, and rebuild 725 ;; This overrides the default "pre-built" steps that skip checkout-ref 726 `(:build (elpaca--fetch 727 elpaca--checkout-ref 728 elpaca--run-pre-build-commands 729 elpaca--queue-dependencies 730 elpaca--check-version 731 elpaca--link-build-files 732 elpaca--generate-autoloads-async 733 elpaca--byte-compile 734 elpaca--compile-info 735 elpaca--install-info 736 elpaca--add-info-path 737 elpaca--run-post-build-commands)))))) 738 739 (defun backpack--setup-elpaca-for-mode () 740 "Configure elpaca based on `backpack-mode'." 741 (when (featurep 'elpaca) 742 (cond 743 ((backpack-sync-mode-p) 744 ;; Sync mode: do everything except activation 745 (setq elpaca-build-steps backpack--sync-build-steps) 746 ;; Add recipe function to detect ref changes and force rebuild 747 ;; This handles the case where a package is already built but 748 ;; the :ref in the recipe has been updated to a different commit 749 (add-to-list 'elpaca-recipe-functions #'backpack--recipe-force-rebuild-on-ref-change)) 750 ((backpack-normal-mode-p) 751 ;; Normal mode: add recipe function to prevent building unbuilt packages 752 (add-to-list 'elpaca-recipe-functions #'backpack--recipe-skip-unbuilt-in-normal-mode))))) 753 754 (defun backpack--recipe-skip-unbuilt-in-normal-mode (recipe) 755 "Modify RECIPE to skip building in normal mode if package isn't already built. 756 Returns a plist with :build set to activation-only steps for unbuilt packages." 757 (when (backpack-normal-mode-p) 758 (let* ((package (plist-get recipe :package)) 759 (build-dir (when package 760 (expand-file-name package elpaca-builds-directory))) 761 (builtp (and build-dir (file-exists-p build-dir)))) 762 (unless builtp 763 ;; Package is not built - in normal mode, we should not try to build it 764 ;; Return :build nil to effectively skip this package's build 765 ;; but still allow queuing (for dependency tracking) 766 (message "Backpack: Package '%s' is not installed. Run 'backpack ensure'." package) 767 '(:build nil))))) 768 769 ;; Initialize elpaca 770 (backpack--ensure-elpaca) 771 772 ;; Configure elpaca based on backpack mode after loading 773 (with-eval-after-load 'elpaca 774 (backpack--setup-elpaca-for-mode) 775 776 ;; Advise elpaca to collect package names during gc mode 777 (defun backpack--elpaca-gc-advice (orig-fn order &rest body) 778 "Advice for `elpaca' macro to collect package names during gc mode. 779 In gc mode, just collect the package name without actually queuing. 780 ORIG-FN is the original function, ORDER is the package order, BODY is the rest." 781 (let* ((order-val (if (and (consp order) (eq (car order) 'quote)) 782 (cadr order) 783 order)) 784 (pkg-name (cond 785 ((symbolp order-val) order-val) 786 ((consp order-val) (car order-val)) 787 (t nil)))) 788 (if (backpack-gc-mode-p) 789 ;; In gc mode, just collect the package name 790 (when pkg-name 791 (backpack--gc-collect-package pkg-name) 792 nil) 793 ;; Normal operation - call original 794 (apply orig-fn order body)))) 795 796 (advice-add 'elpaca--expand-declaration :around #'backpack--elpaca-gc-advice) 797 798 ;; In sync mode, prevent elpaca from running deferred config forms 799 ;; EXCEPT for packages marked with backpack-enable-on-sync! 800 801 (defun backpack--elpaca-skip-forms-in-sync-mode (orig-fn q) 802 "Advice to skip running deferred forms in sync mode. 803 ORIG-FN is `elpaca--finalize-queue', Q is the queue being finalized. 804 Packages in `backpack--enable-on-sync-packages' will still have their forms run." 805 (if (backpack-sync-mode-p) 806 ;; In sync mode, only keep forms for packages marked with backpack-enable-on-sync! 807 (condition-case err 808 (let ((filtered nil) 809 (original-forms (elpaca-q<-forms q))) 810 ;; Filter forms - keep only those for enable-on-sync packages 811 (dolist (entry original-forms) 812 (when (memq (car entry) backpack--enable-on-sync-packages) 813 (push entry filtered))) 814 ;; Directly modify the struct using setcar on the forms cons cell 815 ;; The elpaca-q struct is a tagged list: (elpaca-q ID STATUS TIME ELPACAS PROCESSED TYPE AUTOLOADS FORMS ...) 816 ;; Forms is at position 7 (0-indexed) 817 (let ((forms-cell (nthcdr 7 q))) 818 (setcar forms-cell (nreverse filtered))) 819 (funcall orig-fn q)) 820 (error 821 (message "Backpack: Error in forms filtering: %S" err) 822 (funcall orig-fn q))) 823 ;; Normal mode - run as usual 824 (funcall orig-fn q))) 825 826 (advice-add 'elpaca--finalize-queue :around #'backpack--elpaca-skip-forms-in-sync-mode)) 827 828 (defvar backpack-after-init-hook nil 829 "Abnormal hook for functions to be run after Backpack was initialized.") 830 831 (defun backpack--packages-need-sync-p () 832 "Return non-nil if packages need synchronization (installation/building). 833 This checks if the elpaca builds directory exists and has content." 834 (not (and (file-exists-p elpaca-builds-directory) 835 (directory-files elpaca-builds-directory nil "^[^.]" t)))) 836 837 (defun backpack--check-packages-installed () 838 "Check if packages are installed, warn user if sync is needed." 839 (when (and (backpack-normal-mode-p) 840 (backpack--packages-need-sync-p)) 841 (display-warning 842 'backpack 843 "Packages are not installed. Run 'backpack ensure' to install them." 844 :warning))) 845 846 (defun backpack--activate-packages () 847 "Activate all queued packages without attempting installation. 848 Used in normal mode when packages are already built. 849 In normal mode, elpaca will automatically use pre-built steps for 850 packages that already have build directories." 851 (when (and (backpack-normal-mode-p) (featurep 'elpaca)) 852 ;; Check if packages need sync first 853 (backpack--check-packages-installed) 854 ;; Process queues - elpaca will automatically detect pre-built packages 855 ;; and use activation-only steps for them 856 (elpaca-process-queues))) 857 858 (defun backpack--sync-packages () 859 "Install and build all queued packages without activation. 860 Used in sync mode (`backpack ensure')." 861 (when (and (backpack-sync-mode-p) (featurep 'elpaca)) 862 (backpack--setup-elpaca-for-mode) 863 (elpaca-process-queues))) 864 865 (defun backpack-start (&optional interactive?) 866 "Start the Backpack session. 867 When INTERACTIVE? is non-nil, we're in a normal interactive Emacs session. 868 The behavior depends on `backpack-mode': 869 - In `normal' mode: only activate pre-built packages 870 - In `sync' mode: install/build packages without activation" 871 (when (daemonp) 872 (message "Starting in daemon mode...") 873 (add-hook 'kill-emacs-hook 874 (lambda () 875 (message "Killing Emacs. ¡Adiós!")) 876 100)) 877 878 ;; Ensure required directories exist 879 (with-file-modes 448 880 (mapc (lambda (dir) 881 (make-directory dir t)) 882 (list backpack-cache-dir 883 backpack-nonessential-dir 884 backpack-state-dir 885 backpack-data-dir 886 backpack-tree-sitter-installation-dir))) 887 888 (if interactive? 889 (progn 890 ;; Configure appropriate hook based on mode 891 (cond 892 ((backpack-normal-mode-p) 893 ;; Normal mode: activate packages after init 894 (add-hook 'backpack-after-init-hook #'backpack--activate-packages)) 895 ((backpack-sync-mode-p) 896 ;; Sync mode: build packages (without activation) 897 (add-hook 'backpack-after-init-hook #'backpack--sync-packages))) 898 899 ;; last hook to run in Emacs' startup process. 900 (advice-add #'command-line-1 :after #'backpack-finalize) 901 902 ;; load user's private configuration 903 (let ((init-file (expand-file-name "init.el" backpack-user-dir))) 904 (load init-file t) 905 ;; load custom file 906 (load custom-file t) 907 ;; load all gears 908 (backpack-load-gear-files))) 909 (progn ;; CLI/batch mode 910 nil)) 911 912 ;; load site files 913 (let ((site-loader 914 (lambda () 915 (unless site-run-file 916 (when-let* ((site-file (get 'site-run-file 'initial-value))) 917 (let ((inhibit-startup-screen inhibit-startup-screen)) 918 (setq site-run-file site-file) 919 (load site-run-file t))))))) 920 921 (if interactive? 922 (define-advice startup--load-user-init-file (:before (&rest _) load-site-files 100) 923 (funcall site-loader)) 924 (funcall site-loader))) 925 t) 926 927 (defun backpack-finalize (&rest _) 928 "After the startup process finalizes." 929 (setq backpack-init-time (float-time (time-subtract (current-time) before-init-time))) 930 931 ;; Run backpack hooks which will trigger package processing 932 (run-hooks 'backpack-after-init-hook) 933 934 (when (eq (default-value 'gc-cons-threshold) most-positive-fixnum) 935 (setq-default gc-cons-threshold (* 16 1024 1024))) 936 937 (when (backpack-normal-mode-p) 938 (message "Backpack initialized in %.2fs" backpack-init-time)) 939 t) 940 941 (defun backpack-load-gear-files () 942 "Load all gears available." 943 (load (expand-file-name "gears/config/default" backpack-core-dir)) 944 (load (expand-file-name "gears/ui/theme" backpack-core-dir)) 945 (load (expand-file-name "gears/ui/treesit" backpack-core-dir)) 946 (load (expand-file-name "gears/completion/corfu" backpack-core-dir)) 947 (load (expand-file-name "gears/completion/eglot" backpack-core-dir)) 948 (load (expand-file-name "gears/completion/marginalia" backpack-core-dir)) 949 (load (expand-file-name "gears/completion/nerd-icons-completion" backpack-core-dir)) 950 (load (expand-file-name "gears/completion/orderless" backpack-core-dir)) 951 (load (expand-file-name "gears/completion/vertico" backpack-core-dir)) 952 (load (expand-file-name "gears/tools/eldoc" backpack-core-dir)) 953 (load (expand-file-name "gears/tools/envrc" backpack-core-dir)) 954 (load (expand-file-name "gears/tools/magit" backpack-core-dir)) 955 (load (expand-file-name "gears/tools/whitespaces" backpack-core-dir)) 956 (load (expand-file-name "gears/checkers/spellchecking" backpack-core-dir)) 957 (load (expand-file-name "gears/email/mu4e" backpack-core-dir)) 958 (load (expand-file-name "gears/editing/emacs-lisp" backpack-core-dir)) 959 (load (expand-file-name "gears/editing/go" backpack-core-dir)) 960 (load (expand-file-name "gears/editing/haskell" backpack-core-dir)) 961 (load (expand-file-name "gears/editing/hyprland" backpack-core-dir)) 962 (load (expand-file-name "gears/editing/json" backpack-core-dir)) 963 (load (expand-file-name "gears/editing/latex" backpack-core-dir)) 964 (load (expand-file-name "gears/editing/lua" backpack-core-dir)) 965 (load (expand-file-name "gears/editing/markdown" backpack-core-dir)) 966 (load (expand-file-name "gears/editing/nix" backpack-core-dir)) 967 (load (expand-file-name "gears/editing/org" backpack-core-dir)) 968 (load (expand-file-name "gears/editing/python" backpack-core-dir)) 969 (load (expand-file-name "gears/editing/rst" backpack-core-dir)) 970 (load (expand-file-name "gears/editing/rust" backpack-core-dir)) 971 (load (expand-file-name "gears/editing/terraform" backpack-core-dir)) 972 (load (expand-file-name "gears/editing/toml" backpack-core-dir))) 973 974 ;;; Garbage Collection (orphaned packages cleanup) 975 976 (defvar backpack--gc-mode nil 977 "When non-nil, we're in garbage collection mode. 978 In this mode, we collect package names without actually installing them.") 979 980 (defvar backpack--queued-packages nil 981 "List of package names that would be queued based on current configuration. 982 This is populated during gc mode.") 983 984 (defun backpack-gc-mode-p () 985 "Return non-nil if Backpack is in garbage collection mode." 986 (eq backpack--gc-mode t)) 987 988 (defun backpack--gc-collect-package (package-name) 989 "Add PACKAGE-NAME to the list of queued packages during gc collection." 990 (when (and package-name (symbolp package-name)) 991 (cl-pushnew package-name backpack--queued-packages))) 992 993 (defun backpack--get-installed-packages () 994 "Return a list of package names that are currently installed (have build dirs)." 995 (when (file-exists-p elpaca-builds-directory) 996 (mapcar #'intern 997 (cl-remove-if 998 (lambda (name) (member name '("." ".."))) 999 (directory-files elpaca-builds-directory nil "^[^.]"))))) 1000 1001 (defun backpack--get-repo-packages () 1002 "Return a list of package names that have repos cloned." 1003 (when (file-exists-p elpaca-repos-directory) 1004 (mapcar #'intern 1005 (cl-remove-if 1006 (lambda (name) (member name '("." ".."))) 1007 (directory-files elpaca-repos-directory nil "^[^.]"))))) 1008 1009 (defun backpack--get-package-dependencies (package-name) 1010 "Get the dependencies of PACKAGE-NAME by reading its main elisp file. 1011 Returns a list of dependency package names (symbols)." 1012 (let* ((build-dir (expand-file-name (symbol-name package-name) elpaca-builds-directory)) 1013 (repo-dir (expand-file-name (symbol-name package-name) elpaca-repos-directory)) 1014 (pkg-name-str (symbol-name package-name)) 1015 ;; Try to find the main file or -pkg.el file 1016 (main-file (or (let ((f (expand-file-name (concat pkg-name-str ".el") build-dir))) 1017 (and (file-exists-p f) f)) 1018 (let ((f (expand-file-name (concat pkg-name-str ".el") repo-dir))) 1019 (and (file-exists-p f) f)) 1020 (let ((f (expand-file-name (concat pkg-name-str "-pkg.el") build-dir))) 1021 (and (file-exists-p f) f)) 1022 (let ((f (expand-file-name (concat pkg-name-str "-pkg.el") repo-dir))) 1023 (and (file-exists-p f) f))))) 1024 (when main-file 1025 (with-temp-buffer 1026 (insert-file-contents main-file) 1027 (goto-char (point-min)) 1028 (condition-case nil 1029 (if (string-suffix-p "-pkg.el" main-file) 1030 ;; Parse -pkg.el format: (define-package ... DEPS ...) 1031 (let ((form (read (current-buffer)))) 1032 (when (eq (car form) 'define-package) 1033 (mapcar #'car (nth 4 form)))) 1034 ;; Parse Package-Requires header 1035 (when (re-search-forward "^;+[ \t]*Package-Requires[ \t]*:[ \t]*" nil t) 1036 (let ((deps-str (buffer-substring-no-properties (point) (line-end-position)))) 1037 ;; Handle multi-line Package-Requires 1038 (forward-line 1) 1039 (while (looking-at "^;+[ \t]+\\([^;].*\\)") 1040 (setq deps-str (concat deps-str " " (match-string 1))) 1041 (forward-line 1)) 1042 (condition-case nil 1043 (mapcar #'car (read deps-str)) 1044 (error nil))))) 1045 (error nil)))))) 1046 1047 (defun backpack--collect-all-dependencies (packages) 1048 "Collect all transitive dependencies for PACKAGES. 1049 Returns a list of all packages including dependencies." 1050 (let ((all-packages (copy-sequence packages)) 1051 (to-process (copy-sequence packages)) 1052 (processed nil)) 1053 (while to-process 1054 (let* ((pkg (pop to-process)) 1055 (deps (backpack--get-package-dependencies pkg))) 1056 (push pkg processed) 1057 (dolist (dep deps) 1058 (unless (or (eq dep 'emacs) ; Skip emacs itself 1059 (memq dep all-packages) 1060 (memq dep processed)) 1061 (push dep all-packages) 1062 (push dep to-process))))) 1063 all-packages)) 1064 1065 (defun backpack--find-orphaned-packages () 1066 "Find packages that are installed but not needed by current configuration. 1067 Returns a list of orphaned package names." 1068 (let* ((installed (backpack--get-installed-packages)) 1069 ;; Expand queued packages to include all their dependencies 1070 (needed-with-deps (backpack--collect-all-dependencies backpack--queued-packages))) 1071 (cl-set-difference installed needed-with-deps))) 1072 1073 (defun backpack--delete-package (package-name) 1074 "Delete PACKAGE-NAME's build and repo directories." 1075 (let ((build-dir (expand-file-name (symbol-name package-name) elpaca-builds-directory)) 1076 (repo-dir (expand-file-name (symbol-name package-name) elpaca-repos-directory))) 1077 (when (file-exists-p build-dir) 1078 (message "Backpack GC: Deleting build directory for %s..." package-name) 1079 (delete-directory build-dir t)) 1080 (when (file-exists-p repo-dir) 1081 (message "Backpack GC: Deleting repo directory for %s..." package-name) 1082 (delete-directory repo-dir t)))) 1083 1084 (defun backpack--gc-delete-orphaned-packages (orphaned-packages) 1085 "Delete all ORPHANED-PACKAGES from disk." 1086 (dolist (pkg orphaned-packages) 1087 (backpack--delete-package pkg))) 1088 1089 (defun backpack--calculate-directory-size (directory) 1090 "Calculate the total size of DIRECTORY in bytes." 1091 (let ((total 0)) 1092 (when (file-exists-p directory) 1093 (dolist (file (directory-files-recursively directory ".*" t)) 1094 (unless (file-directory-p file) 1095 (setq total (+ total (or (file-attribute-size (file-attributes file)) 0)))))) 1096 total)) 1097 1098 (defun backpack--format-size (bytes) 1099 "Format BYTES as a human-readable string." 1100 (cond 1101 ((>= bytes (* 1024 1024 1024)) 1102 (format "%.2f GB" (/ bytes (* 1024.0 1024.0 1024.0)))) 1103 ((>= bytes (* 1024 1024)) 1104 (format "%.2f MB" (/ bytes (* 1024.0 1024.0)))) 1105 ((>= bytes 1024) 1106 (format "%.2f KB" (/ bytes 1024.0))) 1107 (t (format "%d bytes" bytes)))) 1108 1109 (defun backpack-gc (&optional dry-run) 1110 "Remove orphaned packages that are no longer needed. 1111 If DRY-RUN is non-nil, only report what would be deleted without deleting." 1112 (setq backpack--queued-packages nil) 1113 (setq backpack--gc-mode t) 1114 1115 ;; Load user configuration to get gear declarations 1116 (let ((init-file (expand-file-name "init.el" backpack-user-dir))) 1117 (when (file-exists-p init-file) 1118 (load init-file t))) 1119 1120 ;; Load all gears to collect package names 1121 ;; The elpaca/leaf macros will call backpack--gc-collect-package in gc mode 1122 (backpack-load-gear-files) 1123 1124 (setq backpack--gc-mode nil) 1125 1126 ;; Always keep elpaca itself 1127 (cl-pushnew 'elpaca backpack--queued-packages) 1128 1129 (let ((orphaned (backpack--find-orphaned-packages))) 1130 (if (null orphaned) 1131 (message "Backpack GC: No orphaned packages found. Nothing to clean up.") 1132 (let ((total-size 0)) 1133 ;; Calculate size of orphaned packages 1134 (dolist (pkg orphaned) 1135 (let ((build-dir (expand-file-name (symbol-name pkg) elpaca-builds-directory)) 1136 (repo-dir (expand-file-name (symbol-name pkg) elpaca-repos-directory))) 1137 (setq total-size (+ total-size 1138 (backpack--calculate-directory-size build-dir) 1139 (backpack--calculate-directory-size repo-dir))))) 1140 1141 (message "") 1142 (message "Backpack GC: Found %d orphaned package(s):" (length orphaned)) 1143 (dolist (pkg orphaned) 1144 (message " - %s" pkg)) 1145 (message "") 1146 (message "Total space to be freed: %s" (backpack--format-size total-size)) 1147 (message "") 1148 1149 (if dry-run 1150 (message "Backpack GC: Dry run - no packages were deleted.") 1151 (backpack--gc-delete-orphaned-packages orphaned) 1152 (message "") 1153 (message "Backpack GC: Deleted %d orphaned package(s), freed %s." 1154 (length orphaned) 1155 (backpack--format-size total-size))))))) 1156 1157 (provide 'backpack)