github.com/replit/upm@v0.0.0-20240423230255-9ce4fc3ea24c/resources/elisp/elpa-search.el (about) 1 ;; This is a script for searching ELPA databases. It is called with 2 ;; three command-line arguments: dir, action, and arg. dir is the name 3 ;; of a temporary directory which can be used as package-user-dir for 4 ;; package.el (normally this would be ~/.emacs.d/elpa). action is 5 ;; either "search" or "info". arg in the case of "search" is a search 6 ;; query, which is split on whitespace and applied conjunctively to 7 ;; filter the results. arg in the case of "info" is the name of a 8 ;; package for which to retrieve info. The script writes to stdout in 9 ;; JSON format, either as a map or an array of maps (see api.PkgInfo). 10 11 (require 'cl-lib) 12 (require 'json) 13 (require 'map) 14 (require 'package) 15 (require 'subr-x) 16 17 ;; Give MELPA priority as it has more up-to-date versions. 18 (setq package-archives '((melpa . "https://melpa.org/packages/") 19 (gnu . "https://elpa.gnu.org/packages/") 20 (org . "https://orgmode.org/elpa/"))) 21 22 (defun upm-convert-package-desc (desc) 23 "Convert package descriptor DESC to alist. 24 The JSON representation of the alist can be unmarshaled directly 25 into a PkgInfo struct in Go." 26 (let ((extras (package-desc-extras desc))) 27 `((name . ,(symbol-name (package-desc-name desc))) 28 (description . ,(package-desc-summary desc)) 29 (version . ,(package-version-join (package-desc-version desc))) 30 (homepageURL . ,(alist-get :url extras)) 31 (author . ,(when-let ((mnt (alist-get :maintainer extras))) 32 (let ((parts nil)) 33 (when-let ((email (cdr mnt))) 34 (push (format "<%s>" email) parts)) 35 (when-let ((name (car mnt))) 36 (push name parts)) 37 (when parts 38 (string-join parts " "))))) 39 (dependencies . ,(cl-remove-if 40 (lambda (dep) 41 (string= dep "emacs")) 42 (mapcar 43 (lambda (link) 44 (symbol-name (car link))) 45 (package-desc-reqs desc))))))) 46 47 (defun upm-package-info (package) 48 "Given PACKAGE string, return alist of metadata for it, or nil." 49 (when-let ((descs (alist-get (intern package) package-archive-contents))) 50 ;; If the same package is available from multiple repositories, 51 ;; prefer the one from the repository which is listed first in 52 ;; `package-archives' (which package.el puts at the *end* of the 53 ;; `package-desc' list). 54 (upm-convert-package-desc 55 (car (last descs))))) 56 57 (defvar upm-num-archives-fetched 0 58 "Number of package.el archives which have been fetched so far.") 59 60 (defun upm-download-callback (action arg) 61 "Callback for downloading on a package.el archive. 62 ACTION is either \"search\" or \"info\". ARG for \"search\" is a 63 search query; ARG for \"info\" is a package name (in either case 64 ARG is a string). Write JSON to stdout." 65 ;; No race condition, Elisp does not have preemptive multithreading. 66 (when (>= (cl-incf upm-num-archives-fetched) (length package-archives)) 67 (package-read-all-archive-contents) 68 (pcase action 69 ("search" 70 (let ((queries (mapcar 71 #'regexp-quote (split-string arg nil 'omit-nulls)))) 72 (thread-last package-archive-contents 73 (map-keys) 74 (mapcar #'symbol-name) 75 (cl-remove-if-not (lambda (package) 76 (cl-every (lambda (query) 77 (string-match-p query package)) 78 queries))) 79 (funcall (lambda (packages) 80 (cl-sort packages #'< :key #'length))) 81 (mapcar #'upm-package-info) 82 (json-encode) 83 (princ)) 84 (terpri))) 85 ("info" 86 (princ 87 (json-encode (upm-package-info arg))) 88 (terpri)) 89 (_ (error "No such action: %S" action))))) 90 91 (cl-destructuring-bind (dir action arg) command-line-args-left 92 (setq command-line-args-left nil) 93 (setq package-user-dir dir) 94 (let ((archives-dir (expand-file-name "archives" package-user-dir))) 95 (dolist (elt package-archives) 96 (cl-destructuring-bind (archive . url) elt 97 (let* ((url (concat url "archive-contents")) 98 (archive-dir 99 (expand-file-name (symbol-name archive) archives-dir)) 100 (archive-file (expand-file-name "archive-contents" archive-dir))) 101 (make-directory archive-dir 'parents) 102 (make-process 103 :name (format "upm-elpa-%S" archive) 104 :command `("curl" "-s" "-o" ,archive-file "--" ,url) 105 :noquery t 106 :sentinel 107 (lambda (proc _event) 108 (unless (process-live-p proc) 109 (unless (zerop (process-exit-status proc)) 110 (error "Failed to download %s: exit code %d" 111 url (process-exit-status proc))) 112 (with-current-buffer (find-file-noselect archive-file) 113 (upm-download-callback action arg)))))))))) 114 115 ;; Wait until all the code has finished running before exiting. 116 (while (< upm-num-archives-fetched (length package-archives)) 117 ;; 50ms is small enough to be imperceptible to the user. 118 (accept-process-output nil 0.05))