/ lisp / backpack-pouch.el
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)