backpack-pouch.el
1 ;; -*- lexical-binding: t; -*- 2 (require 'cl-lib) 3 4 (defvar backpack--gear '() 5 "List of gear in use by the user.") 6 7 (defvar backpack-log-loading nil 8 "Tell Backpack to log every file load.") 9 10 (defmacro gear! (&rest gear) 11 "Declare the GEAR to use." 12 `(setq backpack--gear ',gear)) 13 14 (defmacro gearp! (pouch gear &optional flag) 15 "Check if GEAR in POUCH was enabled. 16 17 For example, if `(gear! :ui (theme doom-one))' then: 18 (gearp! :ui) => nil 19 (gearp! :ui theme) => t 20 (gearp! :ui theme doom-one) => t 21 (gearp! :ui emacs) => nil" 22 `(backpack--gearp!-impl ',pouch ',gear ',flag)) 23 24 (defmacro gear-with-any-flagp! (pouch gear &rest flags) 25 "Check if GEAR in POUCH was enabled with any FLAGS." 26 (let ((flags-sym (gensym "flags")) 27 (flag-sym (gensym "flag")) 28 (found-sym (gensym "found"))) 29 `(let ((,flags-sym (list ,@(mapcar (lambda (f) `',f) flags))) 30 ,flag-sym 31 ,found-sym) 32 (when (null ,flags-sym) 33 (error "No flags passed")) 34 (while (and ,flags-sym (not ,found-sym)) 35 (setq ,flag-sym (pop ,flags-sym)) 36 (when (backpack--gearp!-impl ',pouch ',gear ,flag-sym) 37 (setq ,found-sym t))) 38 ,found-sym))) 39 40 (require 'cl-lib) 41 42 (defun backpack--gearp!-impl (pouch gear &optional flag) 43 "Internal helper for `gearp!`. 44 45 Return non-nil if GEAR in POUCH is active, optionally with FLAG." 46 (let ((category nil) 47 (module nil) 48 (ourflag nil)) 49 (cl-loop for thing in backpack--gear 50 unless (or 51 (and (eq pouch category) (eq gear module) (null flag)) 52 (and (eq pouch category) (eq gear module) (eq ourflag flag))) 53 do 54 (cond 55 ;; the first element is not a pouch/category 56 ((and (null category) 57 (not (keywordp thing))) 58 (error "gear '%s' is not part of a pouch" thing)) 59 60 ;; two pouches in a row without defining gears 61 ((and (null module) 62 category 63 (keywordp thing)) 64 (error "last pouch '%s' did not use any gear" category)) 65 66 ;; found a pouch/category 67 ((keywordp thing) 68 (setq category thing)) 69 70 ;; found a gear/module symbol 71 ((and (symbolp thing) 72 (eq thing gear)) 73 (setq module thing)) 74 75 ;; found a list! => gear + flags 76 ((listp thing) 77 (setq module (pop thing)) 78 (when (memq flag thing) 79 (setq ourflag flag))))) 80 81 ;; return result 82 (or 83 (and (eq pouch category) (eq gear module) (null flag)) 84 (and (eq pouch category) (eq gear module) (eq ourflag flag))))) 85 86 (provide 'backpack-pouch)