diff options
Diffstat (limited to 'admin')
| -rw-r--r-- | admin/scrape-elpa.el | 128 |
1 files changed, 128 insertions, 0 deletions
diff --git a/admin/scrape-elpa.el b/admin/scrape-elpa.el new file mode 100644 index 00000000000..e1072564db6 --- /dev/null +++ b/admin/scrape-elpa.el @@ -0,0 +1,128 @@ +;;; scrape-elpa.el --- Collect ELPA package suggestions -*- lexical-binding: t; -*- + +;; Copyright (C) 2024, 2026 Free Software Foundation, Inc. + +;; Author: Philip Kaludercic <philipk@posteo.net> +;; Keywords: tools + +;; 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: + +;; This file defines an administrative command to update the +;; `package-autosuggest' database. + +;;; Code: + +(require 'rx) + +(defun scrape-elpa--safe-eval (exp &optional vars) + "Manually evaluate EXP without potentially dangerous side-effects. +The optional argument VARS may be an alist mapping symbols to values, +used when evaluating variables. The evaluation function is not meant to +be comprehensive, but just to handle the kinds of expressions that +`scrape-elpa' expects to encounter." + (pcase-exhaustive exp + ;; special handling for macros + (`(rx . ,body) (rx-to-string `(: . ,body) t)) + ;; quoting and quasi-quoting + (`',x x) + (`(purecopy ,x) x) + ((and (guard (eq '\` (car-safe exp))) (let `(,car . ,cdr) (cadr exp))) + (cons + (if (eq (car-safe car) '\,) (scrape-elpa--safe-eval (cadr car) vars) car) + (if (eq (car-safe cdr) '\,) (scrape-elpa--safe-eval (cadr cdr) vars) cdr))) + ;; allow calling `side-effect-free' functions + (`(,(and (pred symbolp) (pred (get _ 'side-effect-free)) fn) . ,args) + (apply fn (mapcar #'scrape-elpa--safe-eval args))) + ;; self-evaluating forms + ((pred macroexp-const-p) exp) + ;; variable evaluation + ((pred symbolp) + (let ((ent (assq exp vars))) + (if ent (cdr ent) (signal 'void-variable exp)))))) + +(defun scrape-elpa (&rest directories) + "Scrape autoload files in DIRECTORIES for package suggestions. +This file will automatically update \"package-autosuggest.eld\", but not +save it. You should invoke this command with built GNU ELPA and NonGNU +ELPA checkouts (i.e. having run \"make autoloads\" in both directories). +Please review the results before updating the autosuggest database!" + (interactive (completing-read-multiple + "ELPA directories to scrape: " + #'completion-file-name-table + #'file-directory-p)) + (with-current-buffer + (find-file (expand-file-name "package-autosuggest.eld" data-directory)) + (erase-buffer) + (lisp-data-mode) + (insert ";; The contents of this file are loaded into `package--autosuggest-database'. +;; were automatically generate by scraping ELPA for auto-loaded +;; code using the `scrape-elpa' command from admin/scrape-elpa.el. Please do not +;; update this file manually! + +") + (fill-paragraph) + (insert "(") + (let ((standard-output (current-buffer))) + (dolist-with-progress-reporter + (file (mapcan + (lambda (dir) + (directory-files-recursively + dir "-autoloads\\.el\\'")) + directories)) + "Scraping files..." + (and-let* (((string-match "/\\([^/]+?\\)-autoloads\\.el\\'" file)) + (pkg (intern (match-string 1 file))) + (vars (list '(#:nihil))) + (inhibit-message t)) + (with-temp-buffer + (insert-file-contents file) + (condition-case nil + (while t + (dolist (exp (macroexp-unprogn (read (current-buffer)))) + (pcase exp + (`(defconst ,(and (pred symbolp) var) ,val . ,_) + (catch 'ignore + (push + (cons var (condition-case err + (scrape-elpa--safe-eval val vars) + (t (message "Failed to evaluate %S: %S in %S" exp err vars) + (throw 'ignore nil)))) + vars))) + (`(add-to-list + ',(and (or 'interpreter-mode-alist + 'magic-mode-alist + 'auto-mode-alist) + variable) + ,(let `(,(and (pred stringp) regexp) . + ,(and (pred symbolp) mode)) + (condition-case err + (scrape-elpa--safe-eval _ vars) + (t (message "Failed to evaluate %S: %S in %S" exp err vars) + nil)))) + (terpri) + (prin1 (append (list pkg variable regexp) + (and (not (eq pkg mode)) (list mode))))) + (`(add-to-list + ',(or 'interpreter-mode-alist + 'magic-mode-alist + 'auto-mode-alist) + _) + (_ (message "Skipped over %S" exp)))))) + (end-of-file nil)))))) + (insert "\n)\n"))) + +(provide 'scrape-elpa) +;;; scrape-elpa.el ends here |