Merge branch 'feature/collect-tags'

Author: akirak

README.org

@@ -1,4 +1,3 @@
-# -*- mode: org; mode: org-make-toc -*-
 * :tags keyword for use-package
 This library adds =:tags= keyword to =use-package=, which can be used
 to enable only packages that belong to certain groups.
@@ -63,6 +62,11 @@ You can get a list of all packages in =use-package= forms in a file, or select p
   (use-package-tags-select '(programming blog)
     :from (expand-file-name "init.el" user-emacs-directory))
 
+  ;; The :from argument also accepts t, which is evaluated to
+  ;; `use-package-tags-init-files' (default: user-init-file)
+  (use-package-tags-select '(programming blog)
+    :from t)
+
   ;; You can select all packages by passing t as the query
   (use-package-tags-select t)
 
@@ -89,3 +93,5 @@ The function handles some built-in keywords of =use-package= to exclude packages
 - Having an =:if= property that evaluates to nil.
 
 Not all keywords are supported right now, but it can be extended to support more keywords.
+
+This package also provides =use-package-tags-collect-tags= function, which returns a list of all tags in a source.

use-package-tags-test.el

@@ -35,7 +35,7 @@
 
 (describe "use-package-tags-select"
   (let ((result (use-package-tags-select '(active foo)
-                  :from "./tests/init.el")))
+                                         :from "./tests/init.el")))
     (it "selects packages without :tags keyword"
       (expect (member 'a result) :to-be-truthy))
     (it "selects packages with an active keyword"
@@ -61,4 +61,18 @@
                                      :as 'lines)
             :to-equal "a\nb\nc\ntest")))
 
+(describe "use-package-tags-collect"
+  (it "collects tags from a source"
+    (expect (use-package-tags-collect-tags "./tests/init.el" :sort t)
+            :to-equal '(active bar foo inactive))))
+
+(describe "use-package-tags--source-buffer-list (private function)"
+  (describe "When t is given"
+    (if (file-exists-p (expand-file-name "init.el" user-emacs-directory))
+        (it "returns use-package-tags-init-files"
+          (expect (mapcar #'buffer-file-name
+                          (use-package-tags--source-buffer-list t))
+                  :to-equal use-package-tags-init-files))
+      (xit "returns use-package-tags-init-files (the file does not exist)"))))
+
 (provide 'use-package-tag-test)

use-package-tags.el

@@ -79,6 +79,64 @@ the conventions of use-package."
 
 ;;;; Extract package names from an init file
 
+(defcustom use-package-tags-init-files
+  (list (or user-init-file
+            (expand-file-name "init.el" user-emacs-directory)))
+  "List of files to look for package declarations."
+  :type '(repeat file))
+
+(defun use-package-tags--source-buffer-list (source)
+  "Return a list of buffers for SOURCE.
+
+If the argument is nil, it returns a list containing the current
+buffer.
+
+Alternatively, the argument can be one of the following:
+
+ * t for `use-package-tags-init-files'.
+ * File name.
+ * Buffer.
+ * List of files.
+ * List of buffers."
+  (cl-labels
+      ((to-buffer
+        (item)
+        (cl-etypecase item
+          (buffer item)
+          ;; (symbol (to-buffer (eval symbol)))
+          (file-exists (or (find-buffer-visiting item)
+                           (find-file-noselect item)))
+          (string (error "File does not exist: %s" item)))))
+    (cl-typecase source
+      (null (list (current-buffer)))
+      (symbol (if (eq t source)
+                  (mapcar #'to-buffer use-package-tags-init-files)
+                ;; TODO: Return the variable value when a symbol is given
+                ;; (list (to-buffer source))
+                (error "Symbol is not accepted: %s" source)))
+      (list (mapcar #'to-buffer source))
+      (otherwise (list (to-buffer source))))))
+
+(defsubst use-package-tags--normalize-query (query)
+  "Normalize QUERY into a list or t."
+  (cl-etypecase query
+    (listp query)
+    (symbolp (or (eq t query)
+                 (list query)))))
+
+(defmacro use-package-tags--with-package-forms (buffers &rest progn)
+  "In BUFFERS, evaluate PROGN at every `use-package' form."
+  (declare (indent 1))
+  `(dolist (buf ,buffers)
+     (with-current-buffer buf
+       (save-excursion
+         (goto-char (point-min))
+         (while (re-search-forward (rx "(use-package" space) nil t)
+           (beginning-of-defun-raw)
+           ,@progn
+           (end-of-defun))))))
+
+;;;###autoload
 (cl-defun use-package-tags-select (query &key from installable
                                          (as 'symbols))
   "Get a list of packages declared in `use-package' forms.
@@ -91,8 +149,8 @@ at least one tag in the query or have no tags.  Alternatively, you
 can select all packages declared in the source by specifying t as
 the query.
 
-By default, the source is the current buffer.
-You can specify a file as the source by setting FROM to its file path.
+FROM specifies the source.
+See `use-package-tags--source-buffer-list'.
 
 When INSTALLABLE is set to non-nil, it returns a list of packages
 available on the Emacs-Mirror.  You will need epkg.el for this feature.
@@ -107,52 +165,40 @@ It accepts the following values (the default: symbols):
  * lines: a single string joined by newlines."
   (declare (indent 1))
   (let (alist
-        (bufs (cl-etypecase from
-                (null (list (current-buffer)))
-                (file-exists-p (list (or (find-buffer-visiting from)
-                                         (find-file-noselect from))))))
-        (query (cl-etypecase query
-                 (listp query)
-                 (symbolp (or (eq t query)
-                              (list query))))))
+        (query (use-package-tags--normalize-query query)))
     (cl-labels
         ((get-keyword (prop rest) (-some->> (member prop rest)
                                     (nth 1))))
-      (dolist (buf bufs)
-        (with-current-buffer buf
-          (save-excursion
-            (goto-char (point-min))
-            (while (re-search-forward (rx "(use-package" space) nil t)
-              (beginning-of-defun-raw)
-              (let* ((exp (read (current-buffer)))
-                     (name (nth 1 exp))
-                     (disabled (get-keyword :disabled exp))
-                     ;; TODO: Handle dependencies
-                     ;; (after (get-keyword :after))
-                     ;; (requires (get-keyword :requires))
-                     ;; TODO: Add support for :when and :unless
-                     (if-expr (get-keyword :if exp))
-                     (tags (get-keyword :tags exp)))
-                (when (and (not disabled)
-                           (not (and if-expr
-                                     (not (eval if-expr))))
-                           ;; TODO: :requires keyword
-                           ;; (or (not requires)
-                           ;;     (-all-p (lambda (feature)
-                           ;;               (assoc feature alist))
-                           ;;             (cl-etypecase requires
-                           ;;               (list requires)
-                           ;;               (symbol (list requires)))))
-                           (or (eq t query)
-                               (not tags)
-                               (cl-intersection tags query)))
-                  (push (list name)
-                        ;; TODO: Handle dependencies
-                        ;; (list name
-                        ;;       :after after
-                        ;;       :requires requires)
-                        alist)))
-              (end-of-defun))))))
+      (use-package-tags--with-package-forms
+          (use-package-tags--source-buffer-list from)
+        (let* ((exp (read (current-buffer)))
+               (name (nth 1 exp))
+               (disabled (get-keyword :disabled exp))
+               ;; TODO: Handle dependencies
+               ;; (after (get-keyword :after))
+               ;; (requires (get-keyword :requires))
+               ;; TODO: Add support for :when and :unless
+               (if-expr (get-keyword :if exp))
+               (tags (get-keyword :tags exp)))
+          (when (and (not disabled)
+                     (not (and if-expr
+                               (not (eval if-expr))))
+                     ;; TODO: :requires keyword
+                     ;; (or (not requires)
+                     ;;     (-all-p (lambda (feature)
+                     ;;               (assoc feature alist))
+                     ;;             (cl-etypecase requires
+                     ;;               (list requires)
+                     ;;               (symbol (list requires)))))
+                     (or (eq t query)
+                         (not tags)
+                         (cl-intersection tags query)))
+            (push (list name)
+                  ;; TODO: Handle dependencies
+                  ;; (list name
+                  ;;       :after after
+                  ;;       :requires requires)
+                  alist)))))
     (cl-labels
         ((enabled-p
           ;; The dependency handle is work in progress.
@@ -220,5 +266,29 @@ It accepts the following values (the default: symbols):
          (delq nil)
          (-uniq))))
 
+;;;###autoload
+(cl-defun use-package-tags-collect-tags (source &key sort)
+  "Collect package tags from a source.
+
+For SOURCE, see `use-package-tags--source-buffer-list'.
+
+If SORT is non-nil, the result will be lexicographically sorted."
+  (cl-labels
+      ((get-keyword (prop rest) (-some->> (member prop rest)
+                                  (nth 1)))
+       (order (items) (if sort
+                          (cl-sort items #'string< :key #'symbol-name)
+                        items)))
+    (let (result)
+      (use-package-tags--with-package-forms
+          (use-package-tags--source-buffer-list source)
+        (let* ((exp (read (current-buffer)))
+               (tags (get-keyword :tags exp)))
+          (when tags
+            (push tags result))))
+      (->> (-flatten-n 1 result)
+           (cl-remove-duplicates)
+           (order)))))
+
 (provide 'use-package-tags)
 ;;; use-package-tags.el ends here