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 +;; 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 . + +;;; 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 diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi index e6432678c62..fdb0822e85c 100644 --- a/doc/emacs/package.texi +++ b/doc/emacs/package.texi @@ -454,6 +454,17 @@ case, Emacs retrieves packages from this archive via ordinary file access. Such local archives are mainly useful for testing. @end defopt +@cindex suggestions +@findex package-autosuggest +@findex package-autosuggest-mode + Emacs has a built-in database of suggested packages for certain file +types. If Emacs opens a file with no specific mode, you can use the +@code{package-autosuggest} command to install the recommended packages +from ELPA. After enabling @code{package-autosuggest-mode}, Emacs will +display a clickable hint in the mode-line if it there is a suggested +package. Using the @code{package-autosuggest-style} user option, you +can adjust how Emacs presents the hint to install a package. + @anchor{Package Signing} @cindex package security @cindex package signing diff --git a/etc/NEWS b/etc/NEWS index fcf04670453..243feba3c0e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2988,6 +2988,17 @@ The package review can include reading the downloaded source code, presenting a diff between the downloaded code and a previous installation or displaying a ChangeLog. ++++ +*** New command 'package-autosuggest' +Using a built-in database of package suggestions from ELPA, this command +will install viable packages if no specific major mode is available. + ++++ +*** New minor mode 'package-autosuggest-mode' +When enabled, this displays a hint in the mode line indicating the +availability of a suggested package. You can customise the presentation +of these hints using 'package-autosuggest-style'. + ** Rcirc +++ diff --git a/etc/package-autosuggest.eld b/etc/package-autosuggest.eld new file mode 100644 index 00000000000..257ad853b97 --- /dev/null +++ b/etc/package-autosuggest.eld @@ -0,0 +1,205 @@ +;; 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! + +( +(a68-mode auto-mode-alist "\\.a68\\'") +(ada-mode auto-mode-alist "\\.ad[abs]\\'") +(arbitools auto-mode-alist "\\.trf?\\'" arbitools-mode) +(auctex auto-mode-alist "\\.hva\\'" LaTeX-mode) +(bnf-mode auto-mode-alist "\\.bnf\\'") +(chess auto-mode-alist "\\.pgn\\'" chess-pgn-mode) +(cobol-mode auto-mode-alist "\\.c\\(ob\\|bl\\|py\\)\\'") +(code-cells auto-mode-alist "\\.ipynb\\'" code-cells-convert-ipynb) +(csharp-mode auto-mode-alist "\\.cs\\'") +(csv-mode auto-mode-alist "\\.[Cc][Ss][Vv]\\'") +(csv-mode auto-mode-alist "\\.tsv\\'" tsv-mode) +(dicom auto-mode-alist "\\.\\(?:dcm\\|ima\\)\\'" dicom-auto-mode) +(dicom auto-mode-alist "DICOMDIR" dicom-auto-mode) +(dismal auto-mode-alist "\\.dis\\'" dismal-mode) +(djvu auto-mode-alist "\\.djvu\\'" djvu-init-mode) +(dts-mode auto-mode-alist "\\.dtsi?\\'") +(ess auto-mode-alist "\\.[Bb][Uu][Gg]\\'" ess-bugs-mode) +(ess auto-mode-alist "\\.[Bb][Oo][Gg]\\'" ess-bugs-mode) +(ess auto-mode-alist "\\.[Bb][Mm][Dd]\\'" ess-bugs-mode) +(ess auto-mode-alist "\\.[Jj][Aa][Gg]\\'" ess-jags-mode) +(ess auto-mode-alist "/R/.*\\.q\\'" ess-r-mode) +(ess auto-mode-alist "\\.[rR]\\'" ess-r-mode) +(ess auto-mode-alist "\\.[rR]profile\\'" ess-r-mode) +(ess auto-mode-alist "NAMESPACE\\'" ess-r-mode) +(ess auto-mode-alist "CITATION\\'" ess-r-mode) +(ess auto-mode-alist "\\.[Rr]out\\'" ess-r-transcript-mode) +(ess interpreter-mode-alist "Rscript" ess-r-mode) +(ess interpreter-mode-alist "r" ess-r-mode) +(ess auto-mode-alist "/Makevars\\(\\.win\\)?\\'" makefile-mode) +(ess auto-mode-alist "DESCRIPTION\\'" conf-colon-mode) +(ess auto-mode-alist "\\.Rd\\'" Rd-mode) +(ess auto-mode-alist "\\.[Ss]t\\'" S-transcript-mode) +(ess auto-mode-alist "\\.Sout\\'" S-transcript-mode) +(ess auto-mode-alist "\\.[Ss][Aa][Ss]\\'" SAS-mode) +(gle-mode auto-mode-alist "\\.gle\\'") +(gpr-mode auto-mode-alist "\\.gpr\\'") +(html5-schema auto-mode-alist "\\.html?\\'" nxml-mode) +(idlwave auto-mode-alist "\\.pro\\'" idlwave-mode) +(jgraph-mode auto-mode-alist "\\.jgr\\'") +(json-mode auto-mode-alist "\\.json\\'") +(lmc auto-mode-alist "\\.elmc\\'" lmc-asm-mode) +(matlab-mode auto-mode-alist "\\.tlc\\'" tlc-mode) +(muse auto-mode-alist "\\.muse\\'" muse-mode-choose-mode) +(auctex auto-mode-alist "\\.drv\\'" latex-mode) +(auctex auto-mode-alist "\\.dtx\\'" doctex-mode) +(nftables-mode auto-mode-alist "\\.nft\\(?:ables\\)?\\'") +(nftables-mode auto-mode-alist "/etc/nftables.conf") +(nftables-mode interpreter-mode-alist "nft\\(?:ables\\)?") +(omn-mode auto-mode-alist "\\.pomn\\'") +(omn-mode auto-mode-alist "\\.omn\\'") +(poke-mode auto-mode-alist "\\.pk\\'") +(pspp-mode auto-mode-alist "\\.sps\\'") +(python auto-mode-alist "\\(?:\\.\\(?:p\\(?:th\\|y[iw]?\\)\\)\\|/\\(?:SCons\\(?:\\(?:crip\\|truc\\)t\\)\\)\\)\\'" python-mode) +(python interpreter-mode-alist "python[0-9.]*" python-mode) +(python auto-mode-alist "/\\(?:Pipfile\\|\\.?flake8\\)\\'" conf-mode) +(rec-mode auto-mode-alist "\\.rec\\'") +(rnc-mode auto-mode-alist "\\.rnc\\'") +(sed-mode auto-mode-alist "\\.sed\\'") +(sed-mode interpreter-mode-alist "sed") +(shen-mode auto-mode-alist "\\.shen\\'") +(show-font auto-mode-alist "\\.\\(ttf\\|otf\\)\\'" show-font-mode) +(sisu-mode auto-mode-alist "\\.ss[imt]\\'") +(smalltalk-mode auto-mode-alist "\\.st\\'") +(smalltalk-mode auto-mode-alist "\\.star\\'" archive-mode) +(sml-mode auto-mode-alist "\\.s\\(ml\\|ig\\)\\'") +(sml-mode auto-mode-alist "\\.cm\\'" sml-cm-mode) +(sml-mode auto-mode-alist "\\.grm\\'" sml-yacc-mode) +(sql-cassandra auto-mode-alist "\\.cql\\'" sql-mode) +(sxhkdrc-mode auto-mode-alist "sxhkdrc\\'") +(systemd auto-mode-alist "\\.automount\\'" systemd-automount-mode) +(systemd auto-mode-alist "\\.mount\\'" systemd-mount-mode) +(systemd auto-mode-alist "\\.path\\'" systemd-path-mode) +(systemd auto-mode-alist "\\.service\\'" systemd-service-mode) +(systemd auto-mode-alist "\\.socket\\'" systemd-socket-mode) +(systemd auto-mode-alist "\\.swap\\'" systemd-swap-mode) +(systemd auto-mode-alist "\\.timer\\'" systemd-timer-mode) +(vcard auto-mode-alist "\\.[Vv][Cc][Ff]\\'" vcard-mode) +(vcl-mode auto-mode-alist "\\.vcl\\'") +(wisi auto-mode-alist "\\.parse_table.*\\'" wisitoken-parse_table-mode) +(wisitoken-grammar-mode auto-mode-alist "\\.wy\\'" simple-indent-mode) +(wisitoken-grammar-mode auto-mode-alist "\\.wy\\'") +(adoc-mode auto-mode-alist "\\.a\\(?:scii\\)?doc\\'") +(apache-mode auto-mode-alist "/\\.htaccess\\'") +(apache-mode auto-mode-alist "/\\(?:access\\|httpd\\|srm\\)\\.conf\\'") +(apache-mode auto-mode-alist "/apache2/.+\\.conf\\'") +(apache-mode auto-mode-alist "/httpd/conf/.+\\.conf\\'") +(apache-mode auto-mode-alist "/apache2/sites-\\(?:available\\|enabled\\)/") +(arduino-mode auto-mode-alist "\\.pde\\'") +(arduino-mode auto-mode-alist "\\.ino\\'") +(beancount auto-mode-alist "\\.beancount\\'" beancount-mode) +(bison-mode auto-mode-alist "\\.y\\'") +(bison-mode auto-mode-alist "\\.l\\'" flex-mode) +(bison-mode auto-mode-alist "\\.jison\\'" jison-mode) +(bqn-mode auto-mode-alist "\\.bqn\\'") +(bqn-mode interpreter-mode-alist "bqn") +(clojure-mode auto-mode-alist "\\.\\(clj\\|cljd\\|dtm\\|edn\\|lpy\\)\\'") +(clojure-mode auto-mode-alist "\\.cljc\\'" clojurec-mode) +(clojure-mode auto-mode-alist "\\.cljs\\'" clojurescript-mode) +(clojure-mode auto-mode-alist "\\(?:build\\|profile\\)\\.boot\\'") +(clojure-mode interpreter-mode-alist "bb") +(clojure-mode interpreter-mode-alist "nbb" clojurescript-mode) +(coffee-mode auto-mode-alist "\\.coffee\\'") +(coffee-mode auto-mode-alist "\\.iced\\'") +(coffee-mode auto-mode-alist "Cakefile\\'") +(coffee-mode auto-mode-alist "\\.cson\\'") +(coffee-mode interpreter-mode-alist "coffee") +(d-mode auto-mode-alist "\\.d[i]?\\'") +(dart-mode auto-mode-alist "\\.dart\\'") +(dockerfile-mode auto-mode-alist "[/\\]\\(?:Containerfile\\|Dockerfile\\)\\(?:\\.[^/\\]*\\)?\\'") +(dockerfile-mode auto-mode-alist "\\.dockerfile\\'") +(drupal-mode auto-mode-alist "[^/]\\.\\(module\\|test\\|install\\|profile\\|tpl\\.php\\|theme\\|inc\\)\\'" php-mode) +(drupal-mode auto-mode-alist "[^/]\\.info\\'" conf-windows-mode) +(drupal-mode auto-mode-alist "[^/]\\.make\\'" drush-make-mode) +(editorconfig auto-mode-alist "\\.editorconfig\\'" editorconfig-conf-mode) +(elixir-mode auto-mode-alist "\\.elixir\\'") +(elixir-mode auto-mode-alist "\\.ex\\'") +(elixir-mode auto-mode-alist "\\.exs\\'") +(elixir-mode auto-mode-alist "mix\\.lock") +(ett auto-mode-alist "\\.ett\\'" ett-mode) +(forth-mode auto-mode-alist "\\.\\(f\\|fs\\|fth\\|4th\\)\\'") +(geiser-racket auto-mode-alist "\\.rkt\\'" scheme-mode) +(gnu-apl-mode auto-mode-alist "\\.apl\\'") +(gnu-apl-mode interpreter-mode-alist "apl") +(go-mode auto-mode-alist "\\.go\\'") +(go-mode auto-mode-alist "go\\.mod\\'" go-dot-mod-mode) +(go-mode auto-mode-alist "go\\.work\\'" go-dot-work-mode) +(graphql-mode auto-mode-alist "\\.graphql\\'") +(graphql-mode auto-mode-alist "\\.gql\\'") +(haml-mode auto-mode-alist "\\.haml\\'") +(haskell-mode auto-mode-alist "\\.hcr\\'" ghc-core-mode) +(haskell-mode auto-mode-alist "\\.dump-simpl\\'" ghc-core-mode) +(haskell-mode auto-mode-alist "\\.ghci\\'" ghci-script-mode) +(haskell-mode auto-mode-alist "\\.chs\\'" haskell-c2hs-mode) +(haskell-mode auto-mode-alist "\\.cabal\\'\\|/cabal\\.project\\|/\\.cabal/config\\'" haskell-cabal-mode) +(haskell-mode auto-mode-alist "\\.[gh]s\\'") +(haskell-mode auto-mode-alist "\\.hsig\\'") +(haskell-mode auto-mode-alist "\\.l[gh]s\\'" haskell-literate-mode) +(haskell-mode auto-mode-alist "\\.hsc\\'") +(haskell-mode interpreter-mode-alist "runghc") +(haskell-mode interpreter-mode-alist "runhaskell") +(haskell-tng-mode auto-mode-alist "\\.hs\\'") +(j-mode auto-mode-alist "\\.ij[rsp]$") +(j-mode auto-mode-alist "\\.ijt$" j-lab-mode) +(jade-mode auto-mode-alist "\\.jade\\'") +(jade-mode auto-mode-alist "\\.pug\\'") +(jade-mode auto-mode-alist "\\.styl\\'" stylus-mode) +(jinja2-mode auto-mode-alist "\\.jinja2\\'") +(jinja2-mode auto-mode-alist "\\.j2\\'") +(julia-mode auto-mode-alist "\\.jl\\'") +(lua-mode auto-mode-alist "\\.lua\\'") +(lua-mode interpreter-mode-alist "lua") +(magit-section auto-mode-alist "/git-rebase-todo\\'" git-rebase-mode) +(magit auto-mode-alist "/git-rebase-todo\\'" git-rebase-mode) +(markdown-mode auto-mode-alist "\\.\\(?:md\\|markdown\\|mkd\\|mdown\\|mkdn\\|mdwn\\)\\'") +(nginx-mode auto-mode-alist "nginx\\.conf\\'") +(nginx-mode auto-mode-alist "/nginx/.+\\.conf\\'") +(nix-mode auto-mode-alist "^/nix/store/.+\\.drv\\'" nix-drv-mode) +(nix-mode auto-mode-alist "\\flake.lock\\'" js-mode) +(nix-mode auto-mode-alist "\\.nix\\'") +(php-mode interpreter-mode-alist "php\\(?:-?[34578]\\(?:\\.[0-9]+\\)*\\)?") +(php-mode auto-mode-alist "/\\.php_cs\\(?:\\.dist\\)?\\'") +(php-mode auto-mode-alist "\\.\\(?:php\\.inc\\|stub\\)\\'") +(php-mode auto-mode-alist "\\.\\(?:php[s345]?\\|phtml\\)\\'" php-mode-maybe) +(proof auto-mode-alist "\\.v\\'" coq-mode) +(racket-mode auto-mode-alist "\\.rkt\\'") +(racket-mode auto-mode-alist "\\.rktd\\'") +(racket-mode auto-mode-alist "\\.rktl\\'") +(racket-mode interpreter-mode-alist "racket") +(raku-mode interpreter-mode-alist "perl6\\|raku") +(raku-mode auto-mode-alist "\\.p[lm]?6\\'") +(raku-mode auto-mode-alist "\\.nqp\\'") +(raku-mode auto-mode-alist "\\.raku\\(?:mod\\|test\\)?\\'") +(rfc-mode auto-mode-alist "/rfc[0-9]+\\.txt\\'") +(rust-mode auto-mode-alist "\\.rs\\'") +(sass-mode auto-mode-alist "\\.sass\\'") +(scad-mode auto-mode-alist "\\.scad\\'") +(scala-mode auto-mode-alist "\\.\\(scala\\|sbt\\|worksheet\\.sc\\)\\'") +(stylus-mode auto-mode-alist "\\.jade\\'" jade-mode) +(stylus-mode auto-mode-alist "\\.pug\\'" jade-mode) +(stylus-mode auto-mode-alist "\\.styl\\'") +(subed auto-mode-alist "\\.ass\\'" subed-ass-mode) +(subed auto-mode-alist "\\.srt\\'" subed-srt-mode) +(subed auto-mode-alist "\\.vtt\\'" subed-vtt-mode) +(swift-mode auto-mode-alist "\\.swift\\(interface\\)?\\'") +(systemd auto-mode-alist "\\.nspawn\\'" systemd-mode) +(systemd auto-mode-alist "[.0-9@-Z\\_a-z-]+?\\.\\(?:automount\\|busname\\|link\\|mount\\|net\\(?:dev\\|work\\)\\|s\\(?:ervice\\|lice\\|ocket\\|wap\\)\\|t\\(?:arget\\|imer\\)\\)\\'" systemd-mode) +(systemd auto-mode-alist "\\.#\\(?:[.0-9@-Z\\_a-z-]+?\\.\\(?:automount\\|busname\\|link\\|mount\\|net\\(?:dev\\|work\\)\\|s\\(?:ervice\\|lice\\|ocket\\|wap\\)\\|t\\(?:arget\\|imer\\)\\)\\|override\\.conf\\)[[:xdigit:]]\\{16\\}\\'" systemd-mode) +(systemd auto-mode-alist "/systemd/[^z-a]+?\\.d/[^/]+?\\.conf\\'" systemd-mode) +(tuareg auto-mode-alist "\\.ml[ip]?\\'" tuareg-mode) +(tuareg auto-mode-alist "\\.eliomi?\\'" tuareg-mode) +(tuareg interpreter-mode-alist "ocamlrun" tuareg-mode) +(tuareg interpreter-mode-alist "ocaml" tuareg-mode) +(tuareg auto-mode-alist "\\.mly\\'" tuareg-menhir-mode) +(tuareg auto-mode-alist "[./]opam_?\\'" tuareg-opam-mode) +(typescript-mode auto-mode-alist "\\.ts\\'") +(yaml-mode auto-mode-alist "\\.\\(e?ya?\\|ra\\)ml\\'") +(yaml-mode magic-mode-alist "^%YAML\\s-+[0-9]+\\.[0-9]+\\(\\s-+#\\|\\s-*$\\)") +(zig-mode auto-mode-alist "\\.\\(zig\\|zon\\)\\'") +) diff --git a/lisp/emacs-lisp/package-activate.el b/lisp/emacs-lisp/package-activate.el index e130304be5c..1689d985c28 100644 --- a/lisp/emacs-lisp/package-activate.el +++ b/lisp/emacs-lisp/package-activate.el @@ -30,6 +30,8 @@ ;; activate packages at startup, as well as other functions that are ;; useful without having to load the entirety of package.el. +;; Note that the contents of this file are preloaded! + ;;; Code: (eval-when-compile (require 'cl-lib)) @@ -534,5 +536,148 @@ the `Version:' header." (require 'lisp-mnt) (lm-package-version mainfile))))))) + +;;;; Package suggestions system + +;; Note that only the definitions necessary to recognise package +;; suggestions are defined here. The user interface to select and act +;; on package suggestions is to be found in package.el. + +(defcustom package-autosuggest-style 'mode-line + "How to draw attention to `package-autosuggest-mode' suggestions. +You can set this value to `mode-line' (default) to indicate the +availability of a package suggestion in the minor mode, `always' to +prompt the user in the minibuffer every time a suggestion is available +in a `fundamental-mode' buffer, or `message' to just display a message +hinting at the existence of a suggestion. If you only wish to be +reminded of package suggestions once every session, consider customizing +the `package-autosuggest-once' user option." + :type '(choice (const :tag "Indicate in mode line" mode-line) + (const :tag "Always prompt" always) + (const :tag "Indicate with message" message)) + :group 'package) + +(defcustom package-autosuggest-once nil + "Non-nil means not to repeat package suggestions." + :type 'boolean + :group 'package) + +(defvar package--autosuggest-database 'unset + "A list of package suggestions. +Each entry in the list is of a form suitable to for +`package--suggestion-applies-p', which see. The special value `unset' +is used to indicate that `package--autosuggest-find-candidates' should +load the database into memory.") + +(defvar package--autosuggest-suggested '() + "List of packages that have already been suggested. +Suggestions found in this list will not count as suggestions (e.g. if +`package-autosuggest-style' is set to `mode-line', a suggestion found in +here will inhibit `package-autosuggest-mode' from displaying a hint in +the mode line).") + +(defun package--suggestion-applies-p (sug) + "Check if a suggestion SUG is applicable to the current buffer. +Each suggestion has the form (PACKAGE TYPE DATA), where PACKAGE is a +symbol denoting the package and major-mode the suggestion applies to, +TYPE is one of `auto-mode-alist', `magic-mode-alist' or +`interpreter-mode-alist' indicating the type of check to be made and +DATA is the value to check against TYPE in the intuitive way (e.g. for +`auto-mode-alist' DATA is a regular expression matching a file name that +PACKAGE should be suggested for). If the package name and the major +mode name differ, then an optional forth element MAJOR-MODE can indicate +what command to invoke to enable the package." + (pcase sug + ((or (guard (not (eq major-mode 'fundamental-mode))) + (guard (and package-autosuggest-once + (not (memq (car sug) package--autosuggest-suggested)))) + `(,(pred package-installed-p) . ,_)) + nil) + (`(,_ auto-mode-alist ,ext . ,_) + (and (buffer-file-name) (string-match-p ext (buffer-file-name)) t)) + (`(,_ magic-mode-alist ,mag . ,_) + (without-restriction + (save-excursion + (goto-char (point-min)) + (looking-at-p mag)))) + (`(,_ interpreter-mode-alist ,intr . ,_) + (without-restriction + (save-excursion + (goto-char (point-min)) + (and (looking-at auto-mode-interpreter-regexp) + (string-match-p + (concat "\\`" (file-name-nondirectory (match-string 2)) "\\'") + intr))))))) + +(defun package--autosuggest-find-candidates () + "Return a list of suggestions that might be interesting the current buffer. +The elements of the returned list will have the form described in +`package--suggestion-applies-p'." + (and (eq major-mode 'fundamental-mode) + (let ((suggetions '())) + (when (eq package--autosuggest-database 'unset) + (setq package--autosuggest-database + (with-temp-buffer + (insert-file-contents + (expand-file-name "package-autosuggest.eld" + data-directory)) + (read (current-buffer))))) + (dolist (sug package--autosuggest-database) + (when (package--suggestion-applies-p sug) + (push sug suggetions))) + suggetions))) + +(defvar package--autosugest-line-format + '(:eval (package--autosugest-line-format))) +(put 'package--autosugest-line-format 'risky-local-variable t) + +(defun package--autosugest-line-format () + "Generate a mode-line string to indicate a suggested package." + `(,@(and-let* (((not (null package-autosuggest-mode))) + ((eq package-autosuggest-style 'mode-line)) + (avail (package--autosuggest-find-candidates))) + (propertize + "[Upgrade?]" + 'face 'mode-line-emphasis + 'mouse-face 'mode-line-highlight + 'help-echo "Click to install suggested package." + 'keymap (let ((map (make-sparse-keymap))) + (define-key map [mode-line down-mouse-1] #'package-autosuggest) + map))))) + +(declare-function package-autosuggest "package" (&optional candidates)) + +(defun package--autosuggest-after-change-mode () + "Display package suggestions for the current buffer. +This function should be added to `after-change-major-mode-hook'." + (when-let* ((avail (package--autosuggest-find-candidates)) + (pkgs (mapconcat #'symbol-name + (delete-dups (mapcar #'car avail)) + ", "))) + (pcase-exhaustive package-autosuggest-style + ('mode-line + (setq mode-name (append (ensure-list mode-name) + '((package-autosuggest-mode + package--autosugest-line-format)))) + (force-mode-line-update t)) + ('always + (package-autosuggest avail)) + ('message + (message + (substitute-command-keys + (format "Found suggested packages: %s. Install using \\[package-autosuggest]" + pkgs))) + (dolist (rec avail) + (add-to-list 'package--autosuggest-suggested (car rec))))))) + +;;;###autoload +(define-minor-mode package-autosuggest-mode + "Enable the automatic suggestion and installation of packages." + :global t :group 'package + ;; :initialize #'custom-initialize-delay + (funcall (if package-autosuggest-mode #'add-hook #'remove-hook) + 'after-change-major-mode-hook + #'package--autosuggest-after-change-mode)) + (provide 'package-activate) ;;; package-activate.el ends here diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 407c4496d81..e2d35f20eb5 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -4529,6 +4529,122 @@ The list is displayed in a buffer named `*Packages*'." (interactive) (list-packages t)) + +;;;; Package Suggestions + +(defun package--autosuggest-install-and-enable (sug) + "Install and enable a package suggestion PKG-ENT. +SUG should be of the form as described in `package--suggestion-applies-p'." + (let ((buffers-to-update '())) + (dolist (buf (buffer-list)) + (with-current-buffer buf + (when (and (eq major-mode 'fundamental-mode) (buffer-file-name) + (package--suggestion-applies-p sug)) + (push buf buffers-to-update)))) + (with-demoted-errors "Failed to install package: %S" + (package-install (car sug)) + (dolist (buf buffers-to-update) + (with-demoted-errors "Failed to enable major mode: %S" + (with-current-buffer buf + (funcall-interactively (or (cadddr sug) (car sug))))))))) + +(defun package--autosugest-prompt (packages) + "Query the user whether to install PACKAGES or not. +PACKAGES is a list of package suggestions in the form as described in +`package--suggestion-applies-p'. The function returns a non-nil value +if affirmative, otherwise nil" + (let* ((inhibit-read-only t) (use-hard-newlines t) + (nl (propertize "\n" 'hard t)) (nlnl (concat nl nl)) + (buf (current-buffer))) + (with-current-buffer (get-buffer-create + (format "*package suggestion: %s*" + (buffer-name buf))) + (erase-buffer) + (insert + "The buffer \"" + (buffer-name buf) + "\" currently lacks any language-specific support. +The package manager can provide the editor support for these kinds of +files by downloading a package from Emacs's package archive:" nl) + + (when (length> packages 1) + (insert nl "(Note that there are multiple candidate packages, +so you have to select which to install!)" nl)) + + (pcase-dolist (`(,pkg . ,sugs) (seq-group-by #'car packages)) + (insert nl "* " + (buttonize (concat "Install " (symbol-name pkg)) + (lambda (_) + (package--autosuggest-install-and-enable + (car sugs)) + (quit-window))) + " (" + (buttonize "about" + (lambda (_) + (unless (assq pkg package-archive-contents) + (package-read-all-archive-contents)) + (describe-package pkg))) + ", matches ") + (dolist (sug sugs) + (unless (eq (char-before) ?\s) + (insert ", ")) + (pcase sug + (`(,_ auto-mode-alist . ,_) + (insert "file extension ")) + (`(,_ magic-mode-alist . ,_) + (insert "magic bytes")) + (`(,_ interpreter-mode-alist . ,_) + (insert "interpreter ")))) + (delete-horizontal-space) (insert ").") + + (add-to-list 'package--autosuggest-suggested pkg)) + + (insert nl "* " (buttonize "Do not install anything" (lambda (_) (quit-window))) "." + nl "* " (buttonize "Permanently disable package suggestions" + (lambda (_) + (customize-save-variable + 'package-autosuggest-mode nil + "Disabled at user's request") + (quit-window))) + "." + + nlnl "To learn more about package management, read " + (buttonize "(emacs) Packages" (lambda (_) (info "(emacs) Packages"))) + ", and to learn more about how Emacs supports specific languages, read " + (buttonize "(emacs) Major modes" (lambda (_) (info "(emacs) Major modes"))) + ".") + + (fill-region (point-min) (point-max)) + (special-mode) + (button-mode t) + + (let ((win (display-buffer-below-selected (current-buffer) '()))) + (fit-window-to-buffer win) + (select-window win) + (set-window-dedicated-p win t) + (set-window-point win (point-min)))))) + +;;;###autoload +(defun package-autosuggest (&optional candidates) + "Prompt the user to install the suggested packages. +The optional argument CANDIDATES may be a list of packages that match +for form described in `package--suggestion-applies-p'. If omitted, the +list of candidates will be computed from the database." + (interactive) + (package--autosugest-prompt + (or candidates + (package--autosuggest-find-candidates) + (user-error "No package suggestions found")))) + +(defun package-reset-suggestions () + "Forget previous package suggestions. +Emacs will remember if you have previously rejected a suggestion during +a session and won't mention it afterwards. If you have made a mistake +or would like to reconsider this, use this command to want to reset the +suggestions." + (interactive) + (setq package--autosuggest-suggested nil)) + ;;;; Quickstart: precompute activation actions for faster start up.