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))