├── docs ├── Screenshot-1.png ├── Screenshot-2.png ├── Screenshot-3.png └── Screenshot-4.png ├── .github ├── FUNDING.yml └── workflows │ ├── dry-run.yml │ └── dry-run.el ├── README.md ├── test.org ├── mason-info.el ├── mason-basic.el ├── mason-manager.el ├── LICENSE └── mason.el /docs/Screenshot-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/deirn/mason.el/HEAD/docs/Screenshot-1.png -------------------------------------------------------------------------------- /docs/Screenshot-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/deirn/mason.el/HEAD/docs/Screenshot-2.png -------------------------------------------------------------------------------- /docs/Screenshot-3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/deirn/mason.el/HEAD/docs/Screenshot-3.png -------------------------------------------------------------------------------- /docs/Screenshot-4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/deirn/mason.el/HEAD/docs/Screenshot-4.png -------------------------------------------------------------------------------- /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | github: deirn 2 | ko_fi: deirn 3 | custom: [paypal.me/deirn, trakteer.id/deirn/tip] 4 | -------------------------------------------------------------------------------- /.github/workflows/dry-run.yml: -------------------------------------------------------------------------------- 1 | name: Dry Run 2 | on: 3 | schedule: 4 | - cron: '0 0 * * *' 5 | workflow_dispatch: 6 | push: 7 | 8 | jobs: 9 | build: 10 | runs-on: ubuntu-latest 11 | steps: 12 | - uses: actions/checkout@v4 13 | - uses: purcell/setup-emacs@b3884972d55f850449e43be74de08f9a97aa3f34 14 | with: 15 | version: 30.1 16 | - run: emacs -Q --batch -l .github/workflows/dry-run.el 17 | -------------------------------------------------------------------------------- /.github/workflows/dry-run.el: -------------------------------------------------------------------------------- 1 | ;; -*- lexical-binding: t; eval: (flymake-mode-off); -*- 2 | 3 | (let* ((s-url "https://raw.githubusercontent.com/magnars/s.el/dda84d38fffdaf0c9b12837b504b402af910d01d/s.el") 4 | (s (make-temp-file "mason-ci-s-" nil ".el")) 5 | (dir (file-name-directory load-file-name)) 6 | (root (expand-file-name "../.." dir))) 7 | (push root load-path) 8 | (url-copy-file s-url s t) 9 | (load s) 10 | (require 'mason) 11 | (let ((mason--log-full-message t) 12 | failed) 13 | (mason-ensure 14 | (lambda () 15 | (mason-dry-run-install-all 16 | (lambda (success total) 17 | (delete-file s) 18 | (setq failed (- total success)))))) 19 | (while (null failed) 20 | (accept-process-output nil 0 1)) 21 | (if (> failed 0) (error "Failed") 22 | (message "Success")))) 23 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # mason.el [![MELPA](https://melpa.org/packages/mason-badge.svg)](https://melpa.org/#/mason) 2 | 3 | mason.el is installer for LSP servers, DAP servers, linters and formatters, 4 | inspired by [mason.nvim](https://github.com/mason-org/mason.nvim). 5 | 6 | Package registry at [mason-org/mason-registry](https://github.com/mason-org/mason-registry). 7 | 8 | - `M-x mason-install RET` to install packages. 9 | - `M-x mason-manager RET` to open package manager. 10 | 11 | ## Screenshots 12 | | | | 13 | |:-------------------------------------------:|:-----------------------------------------:| 14 | | ![Mason manager](docs/Screenshot-1.png) | ![Package info](docs/Screenshot-2.png) | 15 | | `mason-manager` | Package info | 16 | | ![M-x mason-install](docs/Screenshot-3.png) | ![`M-x mason-log`](docs/Screenshot-4.png) | 17 | | `mason-install` | `mason-log` | 18 | | | | 19 | 20 | ## Requirements 21 | mason.el will call external programs such as `cargo` and `npm` to install the packages, 22 | or `tar` and `gzip` to extract downloaded archives. 23 | 24 | Call `(mason-doctor)` to see the requirements of each package type. 25 | 26 | ## Installation 27 | mason.el is available on [MELPA](https://melpa.org/#/mason), install it in your favorite way 28 | and call `(mason-ensure)` to setup the environment. 29 | 30 | ### Install it with `use-package` 31 | ``` emacs-lisp 32 | (use-package mason 33 | :ensure t 34 | :config 35 | (mason-ensure)) 36 | ``` 37 | 38 | ### Install it in [Doom Emacs](https://github.com/doomemacs/doomemacs): 39 | Add to `DOOMDIR/packages.el`: 40 | ``` emacs-lisp 41 | (package! mason) 42 | ``` 43 | 44 | Add to `DOOMDIR/config.el`: 45 | ``` emacs-lisp 46 | (use-package! mason 47 | :config 48 | (mason-ensure)) 49 | ``` 50 | 51 | ## Snippets 52 | 53 | ### Programmatically installing packages 54 | mason.el can be used to install packages programmatically: 55 | ``` emacs-lisp 56 | (mason-ensure 57 | (lambda () 58 | (dolist (pkg '("basedpyright" "jdtls" "clangd")) 59 | (unless (mason-installed-p pkg) 60 | (ignore-errors (mason-install pkg)))))) 61 | ``` 62 | This will (try to) install the missing packages. 63 | -------------------------------------------------------------------------------- /test.org: -------------------------------------------------------------------------------- 1 | #+title: Test 2 | 3 | #+begin_src emacs-lisp :tangle yes 4 | (mason--pipe-to-proc "fun1arg2 | fun1(fun1arg1) | fun2 fun2arg1 | fun3") 5 | #+end_src 6 | 7 | #+RESULTS: 8 | : fun3(fun2(fun2arg1, fun1(fun1arg1, fun1arg2))) 9 | 10 | 11 | #+begin_src emacs-lisp :tangle yes 12 | (mason--proc-to-sexp "fun1(fun1arg1, fun2(fun2arg1, 'str1', \"str2\", fun3()))") 13 | #+end_src 14 | 15 | #+RESULTS: 16 | : (fun1 fun1arg1 (fun2 fun2arg1 "str1" "str2" (fun3))) 17 | 18 | 19 | #+begin_src emacs-lisp :tangle yes 20 | (mason--expand 21 | "abc-{{version}}" 22 | (mason--make-hash "version" "1.2.3")) 23 | #+end_src 24 | 25 | #+RESULTS: 26 | : abc-1.2.3 27 | 28 | 29 | #+begin_src emacs-lisp :tangle yes 30 | (mason--expand 31 | "abc-{{ version }}" 32 | (mason--make-hash "version" "1.2.3")) 33 | #+end_src 34 | 35 | #+RESULTS: 36 | : abc-1.2.3 37 | 38 | 39 | #+begin_src emacs-lisp :tangle yes 40 | (mason--expand 41 | "abc-{{ version | strip_prefix \"v\"}}" 42 | (mason--make-hash "version" "v1.2.3")) 43 | #+end_src 44 | 45 | #+RESULTS: 46 | : abc-1.2.3 47 | 48 | 49 | #+begin_src emacs-lisp :tangle yes 50 | (mason--expand 51 | "{{some.nested.path | strip_prefix \"no \"}} it works" 52 | (mason--make-hash 53 | "some" (mason--make-hash 54 | "nested" (mason--make-hash 55 | "path" "no yes")))) 56 | #+end_src 57 | 58 | #+RESULTS: 59 | : yes it works 60 | 61 | 62 | #+begin_src emacs-lisp :tangle yes 63 | (let (msg) 64 | (mason-dry-run-install-all 65 | (lambda (a b) 66 | (setq msg (format "Installed %d/%d packages" a b)))) 67 | (while (not msg) 68 | (accept-process-output nil 0.01)) 69 | msg) 70 | #+end_src 71 | 72 | #+RESULTS: 73 | : Installed 544/544 packages 74 | 75 | 76 | #+begin_src emacs-lisp :tangle yes 77 | (let* ((str 78 | '("pkg:bitbucket/birkenfeld/pygments-main@244fd47e07d1014f0aed9c" 79 | "pkg:deb/debian/curl@7.50.3-1?arch=i386&distro=jessie" 80 | "pkg:docker/cassandra@sha256:244fd47e07d1004f0aed9c" 81 | "pkg:docker/customer/dockerimage@sha256:244fd47e07d1004f0aed9c?repository_url=gcr.io" 82 | "pkg:gem/jruby-launcher@1.1.2?platform=java" 83 | "pkg:gem/ruby-advisory-db-check@0.12.4" 84 | "pkg:github/package-url/purl-spec@244fd47e07d1004f0aed9c" 85 | "pkg:golang/google.golang.org/genproto#googleapis/api/annotations" 86 | "pkg:maven/org.apache.xmlgraphics/batik-anim@1.9.1?packaging=sources" 87 | "pkg:maven/org.apache.xmlgraphics/batik-anim@1.9.1?repository_url=repo.spring.io/release" 88 | "pkg:npm/%40angular/animation@12.3.1" 89 | "pkg:npm/foobar@12.3.1" 90 | "pkg:nuget/EnterpriseLibrary.Common@6.0.1304" 91 | "pkg:pypi/django@1.11.1" 92 | "pkg:rpm/fedora/curl@7.50.3-1.fc25?arch=i386&distro=fedora-25" 93 | "pkg:rpm/opensuse/curl@7.56.1-1.1.?arch=i386&distro=opensuse-tumbleweed")) 94 | (purls (mapcar #'mason--parse-purl str))) 95 | (with-temp-buffer 96 | (insert "scheme type namespace name version qualifiers subpath\n") 97 | (dolist (purl purls) 98 | (insert (or (gethash "scheme" purl) "nil") ?\s 99 | (or (gethash "type" purl) "nil") ?\s 100 | (or (gethash "namespace" purl) "nil") ?\s 101 | (or (gethash "name" purl) "nil") ?\s 102 | (or (gethash "version" purl) "nil") ?\s 103 | (if (gethash "qualifiers" purl) 104 | (json-serialize (gethash "qualifiers" purl)) 105 | "nil") 106 | ?\s 107 | (or (gethash "subpath" purl) "nil") ?\n)) 108 | (text-mode) 109 | (align (point-min) (point-max)) 110 | (buffer-string))) 111 | #+end_src 112 | 113 | #+RESULTS: 114 | #+begin_example 115 | scheme type namespace name version qualifiers subpath 116 | pkg bitbucket birkenfeld pygments-main 244fd47e07d1014f0aed9c nil nil 117 | pkg deb debian curl 7.50.3-1 {"distro":"jessie","arch":"i386"} nil 118 | pkg docker nil cassandra sha256:244fd47e07d1004f0aed9c nil nil 119 | pkg docker customer dockerimage sha256:244fd47e07d1004f0aed9c {"repository_url":"gcr.io"} nil 120 | pkg gem nil jruby-launcher 1.1.2 {"platform":"java"} nil 121 | pkg gem nil ruby-advisory-db-check 0.12.4 nil nil 122 | pkg github package-url purl-spec 244fd47e07d1004f0aed9c nil nil 123 | pkg golang google.golang.org genproto nil nil googleapis/api/annotations 124 | pkg maven org.apache.xmlgraphics batik-anim 1.9.1 {"packaging":"sources"} nil 125 | pkg maven org.apache.xmlgraphics batik-anim 1.9.1 {"repository_url":"repo.spring.io/release"} nil 126 | pkg npm @angular animation 12.3.1 nil nil 127 | pkg npm nil foobar 12.3.1 nil nil 128 | pkg nuget nil EnterpriseLibrary.Common 6.0.1304 nil nil 129 | pkg pypi nil django 1.11.1 nil nil 130 | pkg rpm fedora curl 7.50.3-1.fc25 {"distro":"fedora-25","arch":"i386"} nil 131 | pkg rpm opensuse curl 7.56.1-1.1. {"distro":"opensuse-tumbleweed","arch":"i386"} nil 132 | #+end_example 133 | -------------------------------------------------------------------------------- /mason-info.el: -------------------------------------------------------------------------------- 1 | ;;; mason-info.el --- Package info viewer for mason.el -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2025 Dimas Firmansyah 4 | 5 | ;; Author: Dimas Firmansyah 6 | ;; Version: 1.0.0 7 | ;; Homepage: https://github.com/deirn/mason.el 8 | ;; This file is not part of GNU Emacs 9 | 10 | ;; This program is free software: you can redistribute it and/or modify 11 | ;; it under the terms of the GNU General Public License as published by 12 | ;; the Free Software Foundation, either version 3 of the License, or 13 | ;; (at your option) any later version. 14 | 15 | ;; This program is distributed in the hope that it will be useful, 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 | ;; GNU General Public License for more details. 19 | 20 | ;; You should have received a copy of the GNU General Public License 21 | ;; along with this program. If not, see . 22 | 23 | ;;; Commentary: 24 | 25 | ;; Package information viewer for mason.el. 26 | ;; Based on elpaca-info.el. 27 | ;; https://github.com/progfolio/elpaca/blob/10e65441f34253254272aeacd300574b576894a2/elpaca-info.el 28 | 29 | ;;; Code: 30 | 31 | (require 'mason) 32 | 33 | (defgroup mason-info nil 34 | "Package information viewer for mason.el." 35 | :prefix "mason-info-" 36 | :group 'mason) 37 | 38 | (defface mason-info-header '((t (:height 2.0 :inherit outline-1))) "Header." :group 'mason-info) 39 | (defface mason-info-subheader '((t (:height 1.5 :inherit outline-2))) "Subheader." :group 'mason-info) 40 | (defface mason-info-section '((t (:weight bold))) "Package section." :group 'mason-info) 41 | (defface mason-info-deprecated '((t (:inherit error))) "Deprecated." :group 'mason-info) 42 | 43 | (defface mason-info-key '((t (:inherit font-lock-keyword-face))) "Property key." :group 'mason-info) 44 | (defface mason-info-array '((t (:inherit font-lock-type-face))) "Property array." :group 'mason-info) 45 | 46 | 47 | ;; The mode 48 | 49 | (define-derived-mode mason-info-mode special-mode "Mason Info" 50 | :interactive nil 51 | (add-hook 'kill-buffer-hook (lambda () (mason--help-map 'mason-info-map 'kill)) nil t)) 52 | 53 | (defvar-local mason-info--pkg nil) 54 | (defvar-local mason-info--json nil) 55 | 56 | ;;;###autoload 57 | (defun mason-info (package &optional interactive) 58 | "Visit Mason info file for PACKAGE. 59 | If INTERACTIVE, ask for PACKAGE." 60 | (interactive '(nil nil)) 61 | (mason--assert-ensured) 62 | (if (and package (not interactive)) 63 | (mason-info--0 (gethash package mason--registry)) 64 | (mason--ask-package "Mason Info" #'identity #'mason-info--0))) 65 | 66 | 67 | ;; Keybinds 68 | 69 | (mason--keymap! mason-info-map 70 | "?" mason-info-show-help 71 | "q" kill-buffer-and-window 72 | "i" mason-info-install 73 | "d" mason-info-delete 74 | "r" mason-info-reload 75 | "J" mason-info-json) 76 | 77 | (defun mason-info-show-help () 78 | "Toggle help window." 79 | (interactive nil mason-info-mode) 80 | (mason--help-map 'mason-info-map)) 81 | 82 | (defun mason-info-install () 83 | "Install/update shown package." 84 | (interactive nil mason-info-mode) 85 | (cond 86 | ((gethash mason-info--pkg mason--updatable) 87 | (when (y-or-n-p (format "Update %s? " mason-info--pkg)) 88 | (mason-update mason-info--pkg t (lambda () (mason-info-reload))))) 89 | ((gethash mason-info--pkg mason--installed) 90 | (message "Package already installed")) 91 | ((y-or-n-p (format "Install %s? " mason-info--pkg)) 92 | (mason-install mason-info--pkg nil t (lambda (_) (mason-info-reload)))))) 93 | 94 | (defun mason-info-delete () 95 | "Delete shown package." 96 | (interactive nil mason-info-mode) 97 | (if (not (gethash mason-info--pkg mason--installed)) 98 | (message "Package not installed") 99 | (when (y-or-n-p (format "Remove %s? " mason-info--pkg)) 100 | (mason-uninstall mason-info--pkg t (lambda (_) (mason-info-reload)))))) 101 | 102 | (defun mason-info-reload () 103 | "Reload current `mason-info-mode' buffer." 104 | (interactive nil mason-info-mode) 105 | (when mason-info--pkg 106 | (let* ((line (line-beginning-position)) 107 | (char (current-column)) 108 | max-char) 109 | (mason-info--0 (gethash mason-info--pkg mason--registry)) 110 | (goto-char line) 111 | (setq max-char (save-excursion 112 | (end-of-line) 113 | (current-column))) 114 | (forward-char (min char max-char))))) 115 | 116 | (defun mason-info-json () 117 | "Toggle show raw JSON spec." 118 | (interactive nil mason-info-mode) 119 | (setq mason-info--json (not mason-info--json)) 120 | (mason-info-reload)) 121 | 122 | 123 | ;; Implementation details 124 | 125 | (defun mason--info-section (str) 126 | "Propertize STR with `mason-info-section'." 127 | (propertize str 'face 'mason-info-section)) 128 | 129 | (defun mason-info--0 (spec) 130 | "Implementation of `mason-info' SPEC." 131 | (let* ((name (gethash "name" spec)) 132 | (description (string-trim (gethash "description" spec))) 133 | (registry (gethash "registry" spec)) 134 | (homepage (gethash "homepage" spec)) 135 | (licenses (gethash "licenses" spec)) 136 | (languages (gethash "languages" spec [])) 137 | (languages (if (seq-empty-p languages) ["None"] languages)) 138 | (categories (gethash "categories" spec [])) 139 | (categories (if (seq-empty-p categories) ["Other"] categories)) 140 | (deprecation (gethash "deprecation" spec)) 141 | (deprecation-since (when deprecation (gethash "since" deprecation))) 142 | (deprecation-message (when deprecation (gethash "message" deprecation))) 143 | (installed (gethash name mason--installed)) 144 | (log (gethash name mason--log)) 145 | (buf (get-buffer-create (format "*mason info for %s*" name))) 146 | (json mason-info--json)) 147 | (with-current-buffer buf 148 | (mason-info-mode) 149 | (setq mason-info--json json) 150 | (read-only-mode -1) 151 | (erase-buffer) 152 | (goto-char (point-min)) 153 | (cond 154 | (json 155 | (when installed 156 | (insert (propertize "installed spec" 'face 'mason-info-subheader) ?\n) 157 | (mason-info--json installed) 158 | (insert "\n\n")) 159 | (insert (propertize "spec" 'face 'mason-info-subheader) ?\n) 160 | (mason-info--json spec)) 161 | (t 162 | (insert 163 | (propertize name 'face 'mason-info-header) ?\n 164 | description ?\n 165 | ?\n) 166 | (when deprecation 167 | (insert 168 | (propertize (format "Deprecated since %s" deprecation-since) 'face 'mason-info-deprecated) ?\n 169 | deprecation-message ?\n 170 | ?\n)) 171 | (insert 172 | (mason--info-section "registry : ") registry ?\n 173 | (mason--info-section "homepage : ") (buttonize homepage #'browse-url homepage) ?\n 174 | (mason--info-section "licenses : ") (mapconcat #'identity licenses ", ") ?\n 175 | (mason--info-section "languages : ") (mapconcat #'identity languages ", ") ?\n 176 | (mason--info-section "categories: ") (mapconcat #'identity categories ", ") ?\n 177 | ?\n) 178 | (when installed 179 | (insert (propertize "installed recipe" 'face 'mason-info-subheader) ?\n) 180 | (mason-info--spec installed) 181 | (insert "\n\n")) 182 | (insert (propertize "recipe" 'face 'mason-info-subheader) ?\n) 183 | (mason-info--spec spec) 184 | (when log 185 | (insert "\n\n" (propertize "logs" 'face 'mason-info-subheader)) 186 | (dolist (l (reverse log)) 187 | (insert ?\n l))) 188 | (insert ?\n))) 189 | (read-only-mode 1) 190 | (goto-char (point-min)) 191 | (pop-to-buffer buf) 192 | (setq-local mason-info--pkg name) 193 | (mason--use-local-map mason-info-map) 194 | (mason--echo (substitute-command-keys (format "\\`%s' for help" (key-description (where-is-internal #'mason-info-show-help mason-info-map t)))))))) 195 | 196 | (defun mason-info--json (spec) 197 | "Insert SPEC as JSON." 198 | (insert 199 | (with-temp-buffer 200 | (delay-mode-hooks (js-json-mode)) 201 | (json-insert spec) 202 | (json-pretty-print (point-min) (point-max)) 203 | (font-lock-ensure) 204 | (buffer-string)))) 205 | 206 | (defun mason-info--spec (spec) 207 | "Insert SPEC." 208 | (let ((source (gethash "source" spec)) 209 | (bin (gethash "bin" spec)) 210 | (share (gethash "share" spec)) 211 | (opt (gethash "opt" spec))) 212 | (insert (mason--info-section "source:")) 213 | (mason-info--table source) 214 | (when bin 215 | (insert "\n\n" (mason--info-section "bin:")) 216 | (mason-info--table bin)) 217 | (when share 218 | (insert "\n\n" (mason--info-section "share:")) 219 | (mason-info--table share)) 220 | (when opt 221 | (insert "\n\n" (mason--info-section "opt:")) 222 | (mason-info--table opt)))) 223 | 224 | (defun mason-info--str (str &optional depth) 225 | "Insert STR with DEPTH." 226 | (setq depth (or depth 0) 227 | str (string-trim str)) 228 | (if (not (s-contains-p "\n" str)) (insert str) 229 | (let ((spc (make-string (* depth 2) ?\s))) 230 | (insert "\n" spc (replace-regexp-in-string "\n" (concat "\n" spc) str))))) 231 | 232 | (defun mason-info--table (table &optional depth ignore-first-depth) 233 | "TABLE info with DEPTH and IGNORE-FIRST-DEPTH." 234 | (setq depth (or depth 0)) 235 | (maphash (lambda (key val) 236 | (if ignore-first-depth 237 | (setq ignore-first-depth nil) 238 | (insert ?\n (make-string (* 2 depth) ?\s))) 239 | (insert (propertize (concat key ":") 'face 'mason-info-key)) 240 | (cond 241 | ((stringp val) (insert " ") (mason-info--str val (1+ depth))) 242 | ((vectorp val) (mason-info--vector val (1+ depth))) 243 | ((hash-table-p val) (mason-info--table val (1+ depth))) 244 | (t (error "Invalid val `%S'" val)))) 245 | table)) 246 | 247 | (defun mason-info--vector (vec &optional depth ignore-first-depth) 248 | "VEC info with DEPTH and IGNORE-FIRST-DEPTH." 249 | (setq depth (or depth 0)) 250 | (mapc (lambda (val) 251 | (if ignore-first-depth 252 | (setq ignore-first-depth nil) 253 | (insert ?\n (make-string (* 2 depth) ?\s))) 254 | (insert (propertize (concat "- ") 'face 'mason-info-array)) 255 | (cond 256 | ((stringp val) (mason-info--str val (1+ depth))) 257 | ((vectorp val) (mason-info--vector val (1+ depth) t)) 258 | ((hash-table-p val) (mason-info--table val (1+ depth) t)) 259 | (t (error "Invalid val `%S'" val)))) 260 | vec)) 261 | 262 | (provide 'mason-info) 263 | 264 | ;;; mason-info.el ends here 265 | -------------------------------------------------------------------------------- /mason-basic.el: -------------------------------------------------------------------------------- 1 | ;;; mason-basic.el --- Basic utilities for mason.el -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2025 Dimas Firmansyah 4 | 5 | ;; Author: Dimas Firmansyah 6 | ;; Version: 1.0.0 7 | ;; Homepage: https://github.com/deirn/mason.el 8 | ;; This file is not part of GNU Emacs 9 | 10 | ;; This program is free software: you can redistribute it and/or modify 11 | ;; it under the terms of the GNU General Public License as published by 12 | ;; the Free Software Foundation, either version 3 of the License, or 13 | ;; (at your option) any later version. 14 | 15 | ;; This program is distributed in the hope that it will be useful, 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 | ;; GNU General Public License for more details. 19 | 20 | ;; You should have received a copy of the GNU General Public License 21 | ;; along with this program. If not, see . 22 | 23 | ;;; Commentary: 24 | 25 | ;; Basic utilities for mason.el. 26 | ;; This contains functions that are "safe" to use in `emacs -Q --batch --eval'. 27 | 28 | ;;; Code: 29 | 30 | (require 'url-parse) 31 | 32 | (defgroup mason nil 33 | "Installer for LSP servers, DAP servers, linters, and formatters." 34 | :prefix "mason-" 35 | :group 'tools) 36 | 37 | (defcustom mason-dry-run nil 38 | "If not nil, only print messages what mason would do." 39 | :type 'boolean :group 'mason) 40 | 41 | (defcustom mason-log-to-message t 42 | "Whether to also append log messages to *Messages* buffer." 43 | :group 'mason 44 | :type '(choice (const :tag "Yes, append to *Messages*" t) 45 | (const :tag "Only print to echo area" echo) 46 | (const :tag "Don't print anything" nil)) ) 47 | 48 | 49 | ;; Macros 50 | 51 | (defmacro mason--make-hash (&rest kvs) 52 | "Make a hash table with `equal' test populated with KVS pairs." 53 | (declare (indent defun)) 54 | `(let ((h (make-hash-table :test 'equal))) 55 | ,@(cl-loop for (k v) on kvs by #'cddr 56 | collect `(puthash ,k ,v h)) 57 | h)) 58 | 59 | 60 | ;; Logging 61 | 62 | (defface mason-log-time '((t . (:inherit shadow))) "Log timestamp." :group 'mason) 63 | (defface mason-log-info '((t)) "Log level info." :group 'mason) 64 | (defface mason-log-warn '((t . (:inherit warning))) "Log level warn." :group 'mason) 65 | (defface mason-log-error '((t . (:inherit error))) "Log level error." :group 'mason) 66 | (defface mason-log-success '((t . (:inherit success))) "Log level success." :group 'mason) 67 | 68 | (defconst mason-buffer " *mason*") 69 | (define-derived-mode mason-log-mode special-mode "Mason Log" 70 | :interactive nil) 71 | 72 | (defvar mason--log (mason--make-hash)) 73 | (defconst mason--log-pkg nil) 74 | 75 | (defun mason--log-clean () 76 | "Cleanup after log buffer killed." 77 | (setq mason--log (mason--make-hash) 78 | mason--log-pkg nil)) 79 | 80 | (defun mason-buffer () 81 | "Get mason buffer." 82 | (or (get-buffer mason-buffer) 83 | (with-current-buffer (get-buffer-create mason-buffer) 84 | (mason-log-mode) 85 | (add-hook 'kill-buffer-hook #'mason--log-clean nil 'local) 86 | (read-only-mode 1) 87 | (current-buffer)))) 88 | 89 | ;;;###autoload 90 | (defun mason-log () 91 | "Show the Mason Log buffer." 92 | (interactive) 93 | (pop-to-buffer (mason-buffer))) 94 | 95 | (defun mason--echo (format &rest args) 96 | "Add message FORMAT ARGS to echo area." 97 | (let ((message-log-max nil)) 98 | (apply #'message format args))) 99 | 100 | (defvar mason--log-full-message nil) 101 | 102 | (defun mason--log (face prefix format args) 103 | "Log with FACE, PREFIX, FORMAT, and ARGS." 104 | (let* ((message-fn (cond ((eq mason-log-to-message t) #'message) 105 | ((eq mason-log-to-message 'echo) #'mason--echo) 106 | (t nil))) 107 | (formatted (apply #'format-message format args)) 108 | (ins (concat 109 | (propertize (format-time-string "[%F %T] ") 'face 'mason-log-time) 110 | (when mason-dry-run (propertize "[DRY] " 'face 'mason-log-time)) 111 | (propertize (concat prefix formatted) 'face face)))) 112 | (when message-fn 113 | (if mason--log-full-message 114 | (funcall message-fn "%s" ins) 115 | (funcall message-fn "%s" formatted))) 116 | (when (and mason--log-pkg (not mason-dry-run)) 117 | (puthash mason--log-pkg 118 | (cons ins (gethash mason--log-pkg mason--log)) 119 | mason--log)) 120 | (with-current-buffer (mason-buffer) 121 | (read-only-mode -1) 122 | (goto-char (point-max)) 123 | (insert ins "\n") 124 | (read-only-mode 1)) 125 | formatted)) 126 | 127 | (defun mason--info (format &rest args) 128 | "Log FORMAT ARGS with info level." 129 | (mason--log 'mason-log-info "" format args)) 130 | 131 | (defun mason--warn (format &rest args) 132 | "Log FORMAT ARGS with warn level." 133 | (mason--log 'mason-log-warn "WARNING: " format args)) 134 | 135 | (defun mason--error (format &rest args) 136 | "Log FORMAT ARGS with error level." 137 | (mason--log 'mason-log-error "ERROR: " format args)) 138 | 139 | (defun mason--success (format &rest args) 140 | "Log FORMAT ARGS with success level." 141 | (mason--log 'mason-log-success "" format args)) 142 | 143 | 144 | ;; Processes 145 | 146 | (defun mason--quote (str &optional always) 147 | "Quote STR if it contains spaces or if ALWAYS non nil." 148 | (if (or always (string-match-p "[[:space:]]" str)) 149 | (format "\"%s\"" (replace-regexp-in-string "\"" "\\\\\"" str)) 150 | str)) 151 | 152 | (cl-defun mason--process-sync (cmd &optional &key in out) 153 | "Run CMD with ARGS synchronously. 154 | See `call-process' INFILE and DESTINATION for IN and OUT." 155 | (let ((prog (car cmd)) 156 | (msg (mapconcat #'mason--quote cmd " ")) 157 | buffer status success) 158 | (mason--info "Calling `%s'" msg) 159 | (when mason-dry-run (cl-return-from mason--process-sync nil)) 160 | (unless (executable-find prog) 161 | (error "Missing program `%s'" prog)) 162 | (setq buffer (generate-new-buffer "*mason process*")) 163 | (with-current-buffer buffer 164 | (setq status (apply #'call-process prog in (or out t) nil (cdr cmd))) 165 | (setq success (zerop status)) 166 | (if success (mason--info "`%s' finished with status %s" msg status) 167 | (mason--error "`%s' failed with status %s" msg status)) 168 | (with-current-buffer (mason-buffer) 169 | (let ((start (point-max))) 170 | (read-only-mode -1) 171 | (goto-char start) 172 | (insert-buffer-substring buffer) 173 | (indent-rigidly start (point) 8) 174 | (read-only-mode 1))) 175 | (kill-buffer buffer) 176 | (unless success (error "Failed `%s'" msg)) 177 | (cons status success)))) 178 | 179 | (defun mason--download (url newname &optional ok-if-already-exists) 180 | "Copy URL to NEWNAME. 181 | OK-IF-ALREADY-EXISTS is the same in `url-copy-file'." 182 | (mason--info "Downloading %s to %s" url newname) 183 | (or mason-dry-run (url-copy-file url newname ok-if-already-exists))) 184 | 185 | 186 | ;; File Utilities 187 | 188 | (defun mason--path-descendant-p (path base) 189 | "Return t if PATH is equal to or underneath BASE." 190 | (let* ((p (directory-file-name path)) 191 | (b (directory-file-name base))) 192 | (string-prefix-p (file-name-as-directory b) 193 | (file-name-as-directory p)))) 194 | 195 | (defun mason--expand-child-file-name (path parent) 196 | "Expand file PATH to PARENT, like `expand-file-name'. 197 | Throws error when resulting path is not inside PARENT." 198 | (let ((res (expand-file-name path parent))) 199 | (unless (mason--path-descendant-p res parent) 200 | (error "Path `%s' is not inside `%s'" res parent)) 201 | res)) 202 | 203 | (defun mason--dir-empty-p (dir) 204 | "Return t if DIR exists and contains no non-dot files." 205 | (and (file-directory-p dir) 206 | (null (directory-files dir nil directory-files-no-dot-files-regexp)))) 207 | 208 | (defun mason--delete-directory (path &optional recursive ignore-dry-run) 209 | "Delete directory at PATH, optionally RECURSIVE. 210 | If IGNORE-DRY-RUN, delete anyway even if `mason-dry-run' is non nil." 211 | (when (or (not mason-dry-run) ignore-dry-run) 212 | (delete-directory path recursive nil)) 213 | (mason--info "Deleted `%s'" (directory-file-name path))) 214 | 215 | (defun mason--delete-file (path &optional ignore-dry-run) 216 | "Delete file at PATH. 217 | If IGNORE-DRY-RUN, delete anyway even if `mason-dry-run' is non nil." 218 | (when (or (not mason-dry-run) ignore-dry-run) 219 | (delete-file path)) 220 | (mason--info "Deleted `%s'" path)) 221 | 222 | (defun mason--read-data (file) 223 | "Read lisp-data FILE." 224 | (when (file-readable-p file) 225 | (with-temp-buffer 226 | (insert-file-contents file) 227 | (goto-char (point-min)) 228 | (read (current-buffer))))) 229 | 230 | 231 | ;; Architecture Resolver 232 | 233 | (defun mason--is-cygwin () 234 | "Returns non nil if `system-type' is cygwin." 235 | (eq system-type 'cygwin)) 236 | 237 | (defun mason--is-windows (&optional cygwin) 238 | "Returns non nil if `system-type' is windows-nt. 239 | Also returns non nil if `system-type' is cygwin when CYGWIN param is non nil." 240 | (or (eq system-type 'windows-nt) 241 | (and cygwin (mason--is-cygwin)))) 242 | 243 | (defun mason--get-target () 244 | "Get current target architecture." 245 | (let (os arch libc) 246 | (cond 247 | ((or (mason--is-windows t)) 248 | (setq os '("windows") 249 | arch (let* ((pa (getenv "PROCESSOR_ARCHITECTURE")) 250 | (wa (getenv "PROCESSOR_ARCHITEW6432")) 251 | (ar (or wa pa ""))) 252 | (cond 253 | ((string-match-p (rx bow (or "AMD64" "x86_64" "X86-64") eow) ar) "x64") 254 | ((string-match-p (rx bow "ARM64" eow) ar) "arm64") 255 | ((string-match-p (rx bow "ARM" eow) arch) "arm32") 256 | ((string-match-p (rx bow (or "x86" "i386" "i686") eow) arch) "x86") 257 | (t nil))) 258 | libc nil)) 259 | ((memq system-type '(ms-dos)) (ignore)) 260 | (t 261 | (setq os (cond 262 | ((eq system-type 'gnu/linux) '("linux" "unix")) 263 | ((eq system-type 'darwin) '("darwin" "unix")) 264 | (t '("unix"))) 265 | arch (when-let* ((uname (ignore-errors (string-trim (car (process-lines "uname" "-m")))))) 266 | (cond 267 | ((string-match-p (rx bow (or "x86_64" "amd64" "x64" "x86-64") eow) uname) "x64") 268 | ((string-match-p (rx bow (or "aarch64" "arm64") eow) uname) "arm64") 269 | ((string-match-p (rx bow (or "armv[0-9]+" "armv[0-9]+l" "arm" "armhf" "armel") eow) uname) "arm32") 270 | ((string-match-p (rx bow (or "x86" "i386" "i686") eow) uname) "x86") 271 | (t nil))) 272 | libc (when-let* ((ldd (ignore-errors (car (process-lines "ldd" "--version"))))) 273 | (cond 274 | ((string-match-p "musl" ldd) "musl") 275 | ((string-match-p (rx (or "GNU libc" "glibc" "GNU C Library")) ldd) "gnu") 276 | (t nil)))))) 277 | (list os arch libc))) 278 | 279 | 280 | ;; Archive Extractors 281 | 282 | (defconst mason--extract-requirements nil) 283 | (defvar mason--extractors nil) 284 | 285 | (defmacro mason--extract! (name ext replace cmd-proc cmd-args &rest args) 286 | "Define an archive extractor NAME for EXT with CMD-PROC and CMD-ARGS. 287 | REPLACE occurrence of EXT with the value if it not nil. 288 | See `mason--process-sync' for CMD and ARGS." 289 | (declare (indent defun)) 290 | (let* ((fn-name (concat "mason--extract-" (symbol-name name))) 291 | (fn (intern fn-name)) 292 | (regexp (macroexpand `(rx "." ,ext eos)))) 293 | `(progn 294 | (push (cons ',name ,cmd-proc) mason--extract-requirements) 295 | (defun ,fn (file dest) 296 | (let* ((default-directory dest) 297 | (out-file (replace-regexp-in-string ,regexp ,replace (file-name-nondirectory file))) 298 | (out-file (mason--expand-child-file-name out-file dest))) 299 | (ignore out-file) 300 | (mason--process-sync `(,,cmd-proc ,@,cmd-args) ,@args))) 301 | (add-to-list 'mason--extractors '(,regexp ,replace ,fn))))) 302 | 303 | (defmacro mason--extract-stdio! (name ext replace cmd-proc cmd-args) 304 | "Extractor for CMD-PROC that outputs to stdout. 305 | See `mason--extract!' for NAME, EXT, REPLACE, CMD-ARGS." 306 | (declare (indent defun)) 307 | `(mason--extract! ,name ,ext ,replace ,cmd-proc ,cmd-args :out `(:file ,out-file))) 308 | 309 | (defun mason--try-extract (file dest) 310 | "Extract FILE to dir DEST, if it can be extracted. 311 | If not, simply move FILE to DEST." 312 | (setq file (expand-file-name file) 313 | dest (file-name-as-directory (expand-file-name dest))) 314 | (let ((tmp-dir (make-temp-file "mason-extract-" 'dir))) 315 | (unwind-protect 316 | (let ((fn (nth 2 (seq-find (lambda (x) (string-match-p (car x) file)) mason--extractors)))) 317 | (when fn 318 | (mason--info "Extracting `%s' to `%s' using `%s'" file tmp-dir (symbol-name fn)) 319 | (unless mason-dry-run 320 | (funcall fn file tmp-dir) 321 | (let ((result (directory-files tmp-dir 'full directory-files-no-dot-files-regexp))) 322 | (if (length< result 2) 323 | ;; single file, try extracting it again 324 | ;; file.tar.gz > file.tar > files 325 | (dolist (file2 result) 326 | (mason--try-extract file2 dest)) 327 | ;; multiple files, can't be a multistage 328 | (make-directory dest t) 329 | (dolist (file2 result) 330 | (rename-file file2 dest)))))) 331 | (unless (or fn mason-dry-run) 332 | (make-directory dest t) 333 | (rename-file file dest))) 334 | (mason--delete-directory tmp-dir t t)))) 335 | 336 | (defun mason--archive-name (archive &optional return-orig) 337 | "Return ARCHIVE file name, without the archive extension. 338 | If not a supported archive, return nil if RETURN-ORIG is nil, 339 | otherwise, return the original file name." 340 | (let* ((rule (seq-find (lambda (x) (string-match-p (car x) archive)) mason--extractors)) 341 | (regexp (nth 0 rule)) 342 | (replace (nth 1 rule))) 343 | (if rule (mason--archive-name (replace-regexp-in-string regexp replace archive) t) 344 | (when return-orig archive)))) 345 | 346 | (mason--extract! 7z "7z" "" "7z" `("x" "-aoa" ,(concat "-o" dest) ,file)) 347 | (mason--extract! tar "tar" "" "tar" `("-xpf" ,file "-C" ,dest)) 348 | (mason--extract! zip (or "zip" "vsix") "" "unzip" `("-o" "-d" ,dest ,file)) 349 | (mason--extract! xar "xar" "" "xar" `("-x" "-f" ,file "-C" ,dest)) 350 | 351 | (mason--extract-stdio! bzip2 "bz2" "" "bunzip2" `("-c" ,file)) 352 | (mason--extract-stdio! dz "dz" "" "dictunzip" `("-c" ,file)) 353 | (mason--extract-stdio! gzip (or "gz" "z") "" "gzip" `("-dc" ,file)) 354 | (mason--extract-stdio! lzip "lz" "" "lzip" `("-dc" ,file)) 355 | (mason--extract-stdio! xz "xz" "" "unxz" `("-c" ,file)) 356 | (mason--extract-stdio! Z "Z" "" "uncompress" `("-c" ,file)) 357 | (mason--extract-stdio! zst "zst" "" "unzstd" `("-c" ,file)) 358 | (mason--extract-stdio! tzst "tzst" ".tar" "unzstd" `("-c" ,file)) 359 | 360 | (defun mason--download-maybe-extract (url dest) 361 | "Download file from URL. 362 | If it is a supported archive, extract into directory DEST. 363 | If not, simply save it as DEST, or inside DEST if it is a directory. 364 | See `mason--extract-strategies'." 365 | (let* ((filename (file-name-nondirectory (url-filename (url-generic-parse-url url)))) 366 | (tmp-dir (make-temp-file "mason-download-" 'dir)) 367 | (tmp-file (mason--expand-child-file-name filename tmp-dir))) 368 | (unwind-protect 369 | (let ((status (mason--download url tmp-file t))) 370 | (unless status 371 | (error "Download failed: %s" url)) 372 | (if (mason--archive-name filename) 373 | (mason--try-extract tmp-file dest) 374 | (unless mason-dry-run 375 | (when (or (directory-name-p dest) (file-directory-p dest)) 376 | (progn (make-directory dest t) 377 | (setq dest (mason--expand-child-file-name filename dest)))) 378 | (make-directory (file-name-parent-directory dest) t) 379 | (copy-file tmp-file dest)) 380 | (mason--info "Copied `%s' to `%s'" tmp-file dest))) 381 | (when (file-directory-p tmp-dir) 382 | (ignore-errors (mason--delete-directory tmp-dir t t)))))) 383 | 384 | (provide 'mason-basic) 385 | 386 | ;;; mason-basic.el ends here 387 | -------------------------------------------------------------------------------- /mason-manager.el: -------------------------------------------------------------------------------- 1 | ;;; mason-manager.el --- Manager for mason.el -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2025 Dimas Firmansyah 4 | 5 | ;; Author: Dimas Firmansyah 6 | ;; Version: 1.0.0 7 | ;; Homepage: https://github.com/deirn/mason.el 8 | ;; This file is not part of GNU Emacs 9 | 10 | ;; This program is free software: you can redistribute it and/or modify 11 | ;; it under the terms of the GNU General Public License as published by 12 | ;; the Free Software Foundation, either version 3 of the License, or 13 | ;; (at your option) any later version. 14 | 15 | ;; This program is distributed in the hope that it will be useful, 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 | ;; GNU General Public License for more details. 19 | 20 | ;; You should have received a copy of the GNU General Public License 21 | ;; along with this program. If not, see . 22 | 23 | ;;; Commentary: 24 | 25 | ;; Package manager view for mason.el 26 | 27 | ;;; Code: 28 | 29 | (require 'mason) 30 | (require 'mason-info) 31 | 32 | (defgroup mason-manager nil 33 | "Package manager view for mason.el." 34 | :prefix "mason-manager-" 35 | :group 'mason) 36 | 37 | (defface mason-manager-package '((t (:weight bold))) "Package name." :group 'mason-manager) 38 | (defface mason-manager-installed '((t (:weight bold :inherit success))) "Installed package name." :group 'mason-manager) 39 | (defface mason-manager-updatable '((t (:weight bold :inherit font-lock-builtin-face))) "Updatable package name." :group 'mason-manager) 40 | (defface mason-manager-pending '((t (:weight bold :inherit warning))) "Pending package name." :group 'mason-manager) 41 | (defface mason-manager-deprecated '((t (:strike-through t))) "Deprecated package name." :group 'mason-manager) 42 | (defface mason-manager-error '((t (:weight bold :inherit error))) "Error package name." :group 'mason-manager) 43 | 44 | (defface mason-manager-mark-install '((t (:inherit success))) "Install Marker." :group 'mason-manager) 45 | (defface mason-manager-mark-update '((t (:inherit font-lock-builtin-face))) "Update Marker." :group 'mason-manager) 46 | (defface mason-manager-mark-delete '((t (:inherit error))) "Delete Marker." :group 'mason-manager) 47 | 48 | (defface mason-manager-language '((t (:inherit font-lock-keyword-face))) "Language filter." :group 'mason-manager) 49 | (defface mason-manager-category '((t (:inherit font-lock-type-face))) "Category filter." :group 'mason-manager) 50 | 51 | 52 | ;; Internal Variables 53 | 54 | (defconst mason-manager--buffer "*mason manager*") 55 | (defvar-local mason-manager--rows nil) 56 | (defvar-local mason-manager--marked nil) 57 | 58 | (defvar mason-manager--category "All") 59 | (defvar mason-manager--language "All") 60 | (defvar mason-manager--installed 'show) 61 | (defvar mason-manager--updatable 'show) 62 | (defvar mason-manager--uninstalled 'show) 63 | (defvar mason-manager--pending 'show) 64 | (defvar mason-manager--deprecated 'hide) 65 | 66 | (defvar-local mason-manager--header-line-advice nil) 67 | 68 | 69 | ;; Keymaps 70 | 71 | (mason--keymap! mason-manager-map 72 | "?" mason-manager-show-help 73 | "q" quit-window 74 | "RET" mason-manager-visit 75 | "l" mason-manager-visit 76 | "L" mason-log 77 | "u" mason-manager-unmark 78 | "U" mason-manager-unmark-all 79 | "i" mason-manager-mark-install 80 | "d" mason-manager-mark-delete 81 | "x" mason-manager-execute 82 | "R" mason-manager-registry-update 83 | "f c" mason-manager-filter-category 84 | "f l" mason-manager-filter-language 85 | "t i" mason-manager-toggle-installed 86 | "t u" mason-manager-toggle-updatable 87 | "t U" mason-manager-toggle-uninstalled 88 | "t p" mason-manager-toggle-pending 89 | "t d" mason-manager-toggle-deprecated) 90 | 91 | (defun mason-manager-show-help () 92 | "Toggle help window." 93 | (interactive nil mason-manager-mode) 94 | (mason--help-map 'mason-manager-map)) 95 | 96 | (defun mason-manager-visit () 97 | "Visit info for package at point." 98 | (interactive nil mason-manager-mode) 99 | (mason-info (tabulated-list-get-id))) 100 | 101 | (defun mason-manager-unmark () 102 | "Unmark package." 103 | (interactive nil mason-manager-mode) 104 | (let ((pkg (tabulated-list-get-id))) 105 | (remhash pkg mason-manager--marked) 106 | (tabulated-list-put-tag "" t))) 107 | 108 | (defun mason-manager-unmark-all () 109 | "Unmark all packages." 110 | (interactive nil mason-manager-mode) 111 | (clrhash mason-manager--marked) 112 | (tabulated-list-clear-all-tags)) 113 | 114 | (defun mason-manager--mark (pkg action tag face) 115 | "Mark PKG at point with ACTION and TAG with FACE." 116 | (if (gethash pkg mason--pending) 117 | (message "Package %s is still being processed" pkg) 118 | (puthash pkg action mason-manager--marked) 119 | (tabulated-list-put-tag (propertize tag 'face face) t))) 120 | 121 | (defun mason-manager-mark-install () 122 | "Mark package to install/update." 123 | (interactive nil mason-manager-mode) 124 | (let* ((pkg (tabulated-list-get-id)) 125 | (installed (gethash pkg mason--installed)) 126 | (updatable (gethash pkg mason--updatable))) 127 | (cond 128 | ((and installed (not updatable)) 129 | (message "Package %s already installed" pkg)) 130 | (updatable 131 | (mason-manager--mark pkg 'update "U" 'mason-manager-mark-update)) 132 | (t 133 | (mason-manager--mark pkg 'install "I" 'mason-manager-mark-install))))) 134 | 135 | (defun mason-manager-mark-delete () 136 | "Mark package to remove." 137 | (interactive nil mason-manager-mode) 138 | (let ((pkg (tabulated-list-get-id))) 139 | (if (not (gethash pkg mason--installed)) 140 | (message "Package %s is not installed" pkg) 141 | (mason-manager--mark pkg 'delete "D" 'mason-manager-mark-delete)))) 142 | 143 | (defun mason-manager-execute () 144 | "Execute install/delete packages." 145 | (interactive nil mason-manager-mode) 146 | (cond 147 | ((hash-table-empty-p mason-manager--marked) 148 | (message "No marked packages")) 149 | ((y-or-n-p "Install/remove marked packages? ") 150 | (maphash 151 | (lambda (pkg action) 152 | (unless (gethash pkg mason--pending) 153 | (cond 154 | ((eq action 'update) 155 | (when (gethash pkg mason--updatable) 156 | (mason-update pkg t nil))) 157 | ((eq action 'install) 158 | (unless (gethash pkg mason--installed) 159 | (mason-install pkg nil t nil))) 160 | ((eq action 'delete) 161 | (when (gethash pkg mason--installed) 162 | (mason-uninstall pkg t nil)))))) 163 | mason-manager--marked) 164 | (mason-manager-unmark-all)))) 165 | 166 | (defun mason-manager-registry-update () 167 | "Update registry." 168 | (interactive nil mason-manager-mode) 169 | (let ((buf (get-buffer mason-manager--buffer))) 170 | (when buf 171 | (with-current-buffer buf 172 | (read-only-mode -1) 173 | (erase-buffer) 174 | (read-only-mode 1)) 175 | (mason-update-registry 176 | (lambda () 177 | (mason-manager--0 :refresh t)))))) 178 | 179 | (defun mason-manager-filter-category () 180 | "Filter by category." 181 | (interactive nil mason-manager-mode) 182 | (mason-manager--0 :f-category (completing-read "Category: " (mason--get-category-list) nil t nil nil "All"))) 183 | 184 | (defun mason-manager-filter-language () 185 | "Filter by language." 186 | (interactive nil mason-manager-mode) 187 | (mason-manager--0 :f-language (completing-read "Language: " (mason--get-language-list) nil t nil nil "All"))) 188 | 189 | (defun mason-manager-toggle-installed () 190 | "Toggle show installed." 191 | (interactive nil mason-manager-mode) 192 | (mason-manager--0 :t-installed (if (eq mason-manager--installed 'show) 'hide 'show))) 193 | 194 | (defun mason-manager-toggle-updatable () 195 | "Toggle show updatable." 196 | (interactive nil mason-manager-mode) 197 | (mason-manager--0 :t-updatable (if (eq mason-manager--updatable 'show) 'hide 'show))) 198 | 199 | (defun mason-manager-toggle-uninstalled () 200 | "Toggle show uninstalled." 201 | (interactive nil mason-manager-mode) 202 | (mason-manager--0 :t-uninstalled (if (eq mason-manager--uninstalled 'show) 'hide 'show))) 203 | 204 | (defun mason-manager-toggle-pending () 205 | "Toggle show pending." 206 | (interactive nil mason-manager-mode) 207 | (mason-manager--0 :t-pending (if (eq mason-manager--pending 'show) 'hide 'show))) 208 | 209 | (defun mason-manager-toggle-deprecated () 210 | "Toggle show deprecated." 211 | (interactive nil mason-manager-mode) 212 | (mason-manager--0 :t-deprecated (if (eq mason-manager--deprecated 'show) 'hide 'show))) 213 | 214 | (defun mason-manager--key-description () 215 | "Return key description." 216 | (let* (desc mapper) 217 | (setq mapper 218 | (lambda (event fn &optional prefix) 219 | (let ((key (key-description (vector event)))) 220 | (if (keymapp fn) 221 | (map-keymap (lambda (e f) (funcall mapper e f key)) fn) 222 | (push (cons (concat (when prefix (concat prefix " ")) key) 223 | (nth 0 (s-split-up-to "\\." (documentation fn) 1 t))) 224 | desc))))) 225 | (map-keymap mapper mason-manager-map) 226 | desc)) 227 | 228 | 229 | ;; The Manager 230 | 231 | (define-derived-mode mason-manager-mode tabulated-list-mode "Mason Manager" 232 | :interactive nil 233 | (add-hook 'quit-window-hook (lambda () (mason--help-map 'mason-manager-map 'kill)) nil t) 234 | (add-hook 'kill-buffer-hook (lambda () (mason--help-map 'mason-manager-map 'kill)) nil t)) 235 | 236 | ;;;###autoload 237 | (defun mason-manager () 238 | "Open mason package manager." 239 | (interactive) 240 | (mason--assert-ensured) 241 | (mason-manager--0)) 242 | 243 | (defun mason-manager--header-line-advice () 244 | "Header line for `mason-manager-mode'." 245 | (when mason-manager--header-line-advice 246 | (let* ((og (format-mode-line header-line-format)) 247 | (max-len (round (/ (string-pixel-width og) (frame-char-width)))) 248 | (og (string-trim-right og)) 249 | (og-len (round (/ (string-pixel-width og) (frame-char-width)))) 250 | (add 251 | (concat 252 | (mason-manager--header-text (format "L:%s" mason-manager--language) 'mason-manager-language #'mason-manager-filter-language) " " 253 | (mason-manager--header-text (format "C:%s" mason-manager--category) 'mason-manager-category #'mason-manager-filter-category) " " 254 | (mason-manager--header-text "INS" (if (eq mason-manager--installed 'show) 'mason-manager-installed 'shadow) #'mason-manager-toggle-installed) " " 255 | (mason-manager--header-text "UPD" (if (eq mason-manager--updatable 'show) 'mason-manager-updatable 'shadow) #'mason-manager-toggle-updatable) " " 256 | (mason-manager--header-text "UNS" (if (eq mason-manager--uninstalled 'show) 'mason-manager-package 'shadow) #'mason-manager-toggle-uninstalled) " " 257 | (mason-manager--header-text "PND" (if (eq mason-manager--pending 'show) 'mason-manager-pending 'shadow) #'mason-manager-toggle-pending) " " 258 | (mason-manager--header-text "DEP" (if (eq mason-manager--deprecated 'show) 'mason-manager-deprecated 'shadow) #'mason-manager-toggle-deprecated))) 259 | (add-len (length add))) 260 | (setq header-line-format 261 | (concat og (make-string (- max-len og-len add-len 2) ?\s) add))))) 262 | 263 | (defun mason-manager--header-text (str face cmd) 264 | "Propertize STR with FACE and CMD click." 265 | (propertize 266 | str 267 | 'face face 'mouse-face 'highlight 268 | 'help-echo (concat "mouse-1: " (documentation cmd)) 269 | 'local-map (let ((map (make-sparse-keymap))) 270 | (define-key map [header-line mouse-1] cmd) 271 | map))) 272 | 273 | (cl-defun mason-manager--0 (&optional &key refresh f-category f-language t-installed t-updatable t-uninstalled t-pending t-deprecated) 274 | "Filter package and show (or REFRESH) manager ui. 275 | Filter by F-CATEGORY F-LANGUAGE 276 | T-INSTALLED T-UPDATABLE T-UNINSTALLED T-PENDING T-DEPRECATED." 277 | (mason--assert-ensured) 278 | (setq f-category (or f-category mason-manager--category) 279 | f-language (or f-language mason-manager--language) 280 | t-installed (or t-installed mason-manager--installed) 281 | t-updatable (or t-updatable mason-manager--updatable) 282 | t-uninstalled (or t-uninstalled mason-manager--uninstalled) 283 | t-pending (or t-pending mason-manager--pending) 284 | t-deprecated (or t-deprecated mason-manager--deprecated)) 285 | (let ((buf (get-buffer mason-manager--buffer))) 286 | (when (or (null buf) 287 | refresh 288 | (not (eq f-category mason-manager--category)) 289 | (not (eq f-language mason-manager--language)) 290 | (not (eq t-installed mason-manager--installed)) 291 | (not (eq t-updatable mason-manager--updatable)) 292 | (not (eq t-uninstalled mason-manager--uninstalled)) 293 | (not (eq t-pending mason-manager--pending)) 294 | (not (eq t-deprecated mason-manager--deprecated))) 295 | (setq buf (get-buffer-create mason-manager--buffer)) 296 | (with-current-buffer buf 297 | (mason-manager-mode) 298 | (read-only-mode -1) 299 | (erase-buffer) 300 | (setq mason-manager--rows (mason--make-hash) 301 | mason-manager--marked (mason--make-hash)) 302 | (let (entries (name-width 20) (version-width 10)) 303 | (maphash 304 | (lambda (pkg spec) 305 | (let* ((name (mason-manager--name pkg)) 306 | (deprecation (gethash "deprecation" spec)) 307 | (description (gethash "description" spec)) 308 | (description (replace-regexp-in-string "\n" " " description)) 309 | (description (if deprecation (concat (propertize "[Deprecated] " 'face 'error) description) description)) 310 | (languages (gethash "languages" spec [])) 311 | (languages (if (seq-empty-p languages) ["None"] languages)) 312 | (categories (gethash "categories" spec [])) 313 | (categories (if (seq-empty-p categories) ["Other"] categories)) 314 | (installed (gethash pkg mason--installed)) 315 | (updatable (gethash pkg mason--updatable)) 316 | (pending (gethash pkg mason--pending)) 317 | (source (gethash "source" spec)) 318 | (source-id (gethash "id" source)) 319 | (purl (mason--parse-purl source-id)) 320 | (version (gethash "version" purl)) 321 | (version (if (not (string-match (rx bol (literal name) (any "/@-") (group (+ any)) eol) version)) version 322 | (match-string 1 version))) 323 | (version (replace-regexp-in-string "^[vV]" "" version)) 324 | (version (replace-regexp-in-string (rx bol (or "untagged-" "0.0.0-")) "" version)) 325 | (version (if (not (string-match-p "^[0-9a-f]\\{20,40\\}$" version)) version 326 | (concat (substring version 0 9) "…")))) 327 | (setq name-width (max name-width (length name)) 328 | version-width (max version-width (length version))) 329 | (let ((show (and (or (eq 'show t-installed) (or (not installed) updatable)) 330 | (or (eq 'show t-updatable) (not updatable)) 331 | (or (eq 'show t-uninstalled) installed) 332 | (or (eq 'show t-pending) (not pending)) 333 | (or (eq 'show t-deprecated) (null deprecation)) 334 | (or (string= f-category "All") (seq-contains-p categories f-category)) 335 | (or (string= f-language "All") (seq-contains-p languages f-language))))) 336 | (when show 337 | (let ((row (vector name version description ""))) 338 | (puthash name row mason-manager--rows) 339 | (push (list pkg row) entries)))))) 340 | mason--registry) 341 | (setq tabulated-list-padding 2 342 | tabulated-list-format (vector `("Name" ,name-width t) 343 | `("Version" ,version-width nil) 344 | '("Description" 100 nil) 345 | '("" 0 nil)) 346 | tabulated-list-entries (nreverse entries) 347 | mason-manager--header-line-advice t 348 | mason-manager--category f-category 349 | mason-manager--language f-language 350 | mason-manager--installed t-installed 351 | mason-manager--updatable t-updatable 352 | mason-manager--uninstalled t-uninstalled 353 | mason-manager--pending t-pending 354 | mason-manager--deprecated t-deprecated)) 355 | (advice-add #'tabulated-list-init-header :after #'mason-manager--header-line-advice) 356 | (tabulated-list-init-header) 357 | (tabulated-list-print) 358 | (read-only-mode 1) 359 | (hl-line-mode 1) 360 | (mason--use-local-map mason-manager-map))) 361 | (pop-to-buffer buf '((display-buffer-reuse-window display-buffer-same-window))) 362 | (mason--echo (substitute-command-keys (format "\\`%s' for help" (key-description (where-is-internal #'mason-manager-show-help mason-manager-map t))))))) 363 | 364 | (defun mason-manager--name (pkg) 365 | "Propertize PKG depending on package status." 366 | (let* ((spec (gethash pkg mason--registry)) 367 | (updatable (gethash pkg mason--updatable)) 368 | (installed (gethash pkg mason--installed)) 369 | (pending (gethash pkg mason--pending)) 370 | (deprecated (gethash "deprecation" spec)) 371 | (face (cond (pending 'mason-manager-pending) 372 | (updatable 'mason-manager-updatable) 373 | (installed 'mason-manager-installed) 374 | (t 'mason-manager-package))) 375 | (face (if deprecated `(,face mason-manager-deprecated) face))) 376 | (propertize pkg 'face face))) 377 | 378 | (defun mason-manager--update (pkg &optional failed) 379 | "Update manager entry for PKG and FAILED." 380 | (let ((manager (get-buffer mason-manager--buffer)) 381 | (current (current-buffer)) 382 | row) 383 | (when manager 384 | (pop-to-buffer manager '((display-buffer-reuse-window display-buffer-same-window))) 385 | (with-current-buffer manager 386 | (setq row (gethash pkg mason-manager--rows)) 387 | (when row 388 | (aset row 0 (if failed (propertize pkg 'face 'mason-manager-error) (mason-manager--name pkg))) 389 | (tabulated-list-print t t))) 390 | (pop-to-buffer current '((display-buffer-reuse-window display-buffer-same-window)))))) 391 | 392 | (provide 'mason-manager) 393 | 394 | ;;; mason-manager.el ends here 395 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 3, 29 June 2007 3 | 4 | Copyright (C) 2007 Free Software Foundation, Inc. 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | Preamble 9 | 10 | The GNU General Public License is a free, copyleft license for 11 | software and other kinds of works. 12 | 13 | The licenses for most software and other practical works are designed 14 | to take away your freedom to share and change the works. By contrast, 15 | the GNU General Public License is intended to guarantee your freedom to 16 | share and change all versions of a program--to make sure it remains free 17 | software for all its users. We, the Free Software Foundation, use the 18 | GNU General Public License for most of our software; it applies also to 19 | any other work released this way by its authors. You can apply it to 20 | your programs, too. 21 | 22 | When we speak of free software, we are referring to freedom, not 23 | price. Our General Public Licenses are designed to make sure that you 24 | have the freedom to distribute copies of free software (and charge for 25 | them if you wish), that you receive source code or can get it if you 26 | want it, that you can change the software or use pieces of it in new 27 | free programs, and that you know you can do these things. 28 | 29 | To protect your rights, we need to prevent others from denying you 30 | these rights or asking you to surrender the rights. Therefore, you have 31 | certain responsibilities if you distribute copies of the software, or if 32 | you modify it: responsibilities to respect the freedom of others. 33 | 34 | For example, if you distribute copies of such a program, whether 35 | gratis or for a fee, you must pass on to the recipients the same 36 | freedoms that you received. You must make sure that they, too, receive 37 | or can get the source code. And you must show them these terms so they 38 | know their rights. 39 | 40 | Developers that use the GNU GPL protect your rights with two steps: 41 | (1) assert copyright on the software, and (2) offer you this License 42 | giving you legal permission to copy, distribute and/or modify it. 43 | 44 | For the developers' and authors' protection, the GPL clearly explains 45 | that there is no warranty for this free software. For both users' and 46 | authors' sake, the GPL requires that modified versions be marked as 47 | changed, so that their problems will not be attributed erroneously to 48 | authors of previous versions. 49 | 50 | Some devices are designed to deny users access to install or run 51 | modified versions of the software inside them, although the manufacturer 52 | can do so. This is fundamentally incompatible with the aim of 53 | protecting users' freedom to change the software. The systematic 54 | pattern of such abuse occurs in the area of products for individuals to 55 | use, which is precisely where it is most unacceptable. Therefore, we 56 | have designed this version of the GPL to prohibit the practice for those 57 | products. If such problems arise substantially in other domains, we 58 | stand ready to extend this provision to those domains in future versions 59 | of the GPL, as needed to protect the freedom of users. 60 | 61 | Finally, every program is threatened constantly by software patents. 62 | States should not allow patents to restrict development and use of 63 | software on general-purpose computers, but in those that do, we wish to 64 | avoid the special danger that patents applied to a free program could 65 | make it effectively proprietary. To prevent this, the GPL assures that 66 | patents cannot be used to render the program non-free. 67 | 68 | The precise terms and conditions for copying, distribution and 69 | modification follow. 70 | 71 | TERMS AND CONDITIONS 72 | 73 | 0. Definitions. 74 | 75 | "This License" refers to version 3 of the GNU General Public License. 76 | 77 | "Copyright" also means copyright-like laws that apply to other kinds of 78 | works, such as semiconductor masks. 79 | 80 | "The Program" refers to any copyrightable work licensed under this 81 | License. Each licensee is addressed as "you". "Licensees" and 82 | "recipients" may be individuals or organizations. 83 | 84 | To "modify" a work means to copy from or adapt all or part of the work 85 | in a fashion requiring copyright permission, other than the making of an 86 | exact copy. The resulting work is called a "modified version" of the 87 | earlier work or a work "based on" the earlier work. 88 | 89 | A "covered work" means either the unmodified Program or a work based 90 | on the Program. 91 | 92 | To "propagate" a work means to do anything with it that, without 93 | permission, would make you directly or secondarily liable for 94 | infringement under applicable copyright law, except executing it on a 95 | computer or modifying a private copy. Propagation includes copying, 96 | distribution (with or without modification), making available to the 97 | public, and in some countries other activities as well. 98 | 99 | To "convey" a work means any kind of propagation that enables other 100 | parties to make or receive copies. Mere interaction with a user through 101 | a computer network, with no transfer of a copy, is not conveying. 102 | 103 | An interactive user interface displays "Appropriate Legal Notices" 104 | to the extent that it includes a convenient and prominently visible 105 | feature that (1) displays an appropriate copyright notice, and (2) 106 | tells the user that there is no warranty for the work (except to the 107 | extent that warranties are provided), that licensees may convey the 108 | work under this License, and how to view a copy of this License. If 109 | the interface presents a list of user commands or options, such as a 110 | menu, a prominent item in the list meets this criterion. 111 | 112 | 1. Source Code. 113 | 114 | The "source code" for a work means the preferred form of the work 115 | for making modifications to it. "Object code" means any non-source 116 | form of a work. 117 | 118 | A "Standard Interface" means an interface that either is an official 119 | standard defined by a recognized standards body, or, in the case of 120 | interfaces specified for a particular programming language, one that 121 | is widely used among developers working in that language. 122 | 123 | The "System Libraries" of an executable work include anything, other 124 | than the work as a whole, that (a) is included in the normal form of 125 | packaging a Major Component, but which is not part of that Major 126 | Component, and (b) serves only to enable use of the work with that 127 | Major Component, or to implement a Standard Interface for which an 128 | implementation is available to the public in source code form. A 129 | "Major Component", in this context, means a major essential component 130 | (kernel, window system, and so on) of the specific operating system 131 | (if any) on which the executable work runs, or a compiler used to 132 | produce the work, or an object code interpreter used to run it. 133 | 134 | The "Corresponding Source" for a work in object code form means all 135 | the source code needed to generate, install, and (for an executable 136 | work) run the object code and to modify the work, including scripts to 137 | control those activities. However, it does not include the work's 138 | System Libraries, or general-purpose tools or generally available free 139 | programs which are used unmodified in performing those activities but 140 | which are not part of the work. For example, Corresponding Source 141 | includes interface definition files associated with source files for 142 | the work, and the source code for shared libraries and dynamically 143 | linked subprograms that the work is specifically designed to require, 144 | such as by intimate data communication or control flow between those 145 | subprograms and other parts of the work. 146 | 147 | The Corresponding Source need not include anything that users 148 | can regenerate automatically from other parts of the Corresponding 149 | Source. 150 | 151 | The Corresponding Source for a work in source code form is that 152 | same work. 153 | 154 | 2. Basic Permissions. 155 | 156 | All rights granted under this License are granted for the term of 157 | copyright on the Program, and are irrevocable provided the stated 158 | conditions are met. This License explicitly affirms your unlimited 159 | permission to run the unmodified Program. The output from running a 160 | covered work is covered by this License only if the output, given its 161 | content, constitutes a covered work. This License acknowledges your 162 | rights of fair use or other equivalent, as provided by copyright law. 163 | 164 | You may make, run and propagate covered works that you do not 165 | convey, without conditions so long as your license otherwise remains 166 | in force. You may convey covered works to others for the sole purpose 167 | of having them make modifications exclusively for you, or provide you 168 | with facilities for running those works, provided that you comply with 169 | the terms of this License in conveying all material for which you do 170 | not control copyright. Those thus making or running the covered works 171 | for you must do so exclusively on your behalf, under your direction 172 | and control, on terms that prohibit them from making any copies of 173 | your copyrighted material outside their relationship with you. 174 | 175 | Conveying under any other circumstances is permitted solely under 176 | the conditions stated below. Sublicensing is not allowed; section 10 177 | makes it unnecessary. 178 | 179 | 3. Protecting Users' Legal Rights From Anti-Circumvention Law. 180 | 181 | No covered work shall be deemed part of an effective technological 182 | measure under any applicable law fulfilling obligations under article 183 | 11 of the WIPO copyright treaty adopted on 20 December 1996, or 184 | similar laws prohibiting or restricting circumvention of such 185 | measures. 186 | 187 | When you convey a covered work, you waive any legal power to forbid 188 | circumvention of technological measures to the extent such circumvention 189 | is effected by exercising rights under this License with respect to 190 | the covered work, and you disclaim any intention to limit operation or 191 | modification of the work as a means of enforcing, against the work's 192 | users, your or third parties' legal rights to forbid circumvention of 193 | technological measures. 194 | 195 | 4. Conveying Verbatim Copies. 196 | 197 | You may convey verbatim copies of the Program's source code as you 198 | receive it, in any medium, provided that you conspicuously and 199 | appropriately publish on each copy an appropriate copyright notice; 200 | keep intact all notices stating that this License and any 201 | non-permissive terms added in accord with section 7 apply to the code; 202 | keep intact all notices of the absence of any warranty; and give all 203 | recipients a copy of this License along with the Program. 204 | 205 | You may charge any price or no price for each copy that you convey, 206 | and you may offer support or warranty protection for a fee. 207 | 208 | 5. Conveying Modified Source Versions. 209 | 210 | You may convey a work based on the Program, or the modifications to 211 | produce it from the Program, in the form of source code under the 212 | terms of section 4, provided that you also meet all of these conditions: 213 | 214 | a) The work must carry prominent notices stating that you modified 215 | it, and giving a relevant date. 216 | 217 | b) The work must carry prominent notices stating that it is 218 | released under this License and any conditions added under section 219 | 7. This requirement modifies the requirement in section 4 to 220 | "keep intact all notices". 221 | 222 | c) You must license the entire work, as a whole, under this 223 | License to anyone who comes into possession of a copy. This 224 | License will therefore apply, along with any applicable section 7 225 | additional terms, to the whole of the work, and all its parts, 226 | regardless of how they are packaged. This License gives no 227 | permission to license the work in any other way, but it does not 228 | invalidate such permission if you have separately received it. 229 | 230 | d) If the work has interactive user interfaces, each must display 231 | Appropriate Legal Notices; however, if the Program has interactive 232 | interfaces that do not display Appropriate Legal Notices, your 233 | work need not make them do so. 234 | 235 | A compilation of a covered work with other separate and independent 236 | works, which are not by their nature extensions of the covered work, 237 | and which are not combined with it such as to form a larger program, 238 | in or on a volume of a storage or distribution medium, is called an 239 | "aggregate" if the compilation and its resulting copyright are not 240 | used to limit the access or legal rights of the compilation's users 241 | beyond what the individual works permit. Inclusion of a covered work 242 | in an aggregate does not cause this License to apply to the other 243 | parts of the aggregate. 244 | 245 | 6. Conveying Non-Source Forms. 246 | 247 | You may convey a covered work in object code form under the terms 248 | of sections 4 and 5, provided that you also convey the 249 | machine-readable Corresponding Source under the terms of this License, 250 | in one of these ways: 251 | 252 | a) Convey the object code in, or embodied in, a physical product 253 | (including a physical distribution medium), accompanied by the 254 | Corresponding Source fixed on a durable physical medium 255 | customarily used for software interchange. 256 | 257 | b) Convey the object code in, or embodied in, a physical product 258 | (including a physical distribution medium), accompanied by a 259 | written offer, valid for at least three years and valid for as 260 | long as you offer spare parts or customer support for that product 261 | model, to give anyone who possesses the object code either (1) a 262 | copy of the Corresponding Source for all the software in the 263 | product that is covered by this License, on a durable physical 264 | medium customarily used for software interchange, for a price no 265 | more than your reasonable cost of physically performing this 266 | conveying of source, or (2) access to copy the 267 | Corresponding Source from a network server at no charge. 268 | 269 | c) Convey individual copies of the object code with a copy of the 270 | written offer to provide the Corresponding Source. This 271 | alternative is allowed only occasionally and noncommercially, and 272 | only if you received the object code with such an offer, in accord 273 | with subsection 6b. 274 | 275 | d) Convey the object code by offering access from a designated 276 | place (gratis or for a charge), and offer equivalent access to the 277 | Corresponding Source in the same way through the same place at no 278 | further charge. You need not require recipients to copy the 279 | Corresponding Source along with the object code. If the place to 280 | copy the object code is a network server, the Corresponding Source 281 | may be on a different server (operated by you or a third party) 282 | that supports equivalent copying facilities, provided you maintain 283 | clear directions next to the object code saying where to find the 284 | Corresponding Source. Regardless of what server hosts the 285 | Corresponding Source, you remain obligated to ensure that it is 286 | available for as long as needed to satisfy these requirements. 287 | 288 | e) Convey the object code using peer-to-peer transmission, provided 289 | you inform other peers where the object code and Corresponding 290 | Source of the work are being offered to the general public at no 291 | charge under subsection 6d. 292 | 293 | A separable portion of the object code, whose source code is excluded 294 | from the Corresponding Source as a System Library, need not be 295 | included in conveying the object code work. 296 | 297 | A "User Product" is either (1) a "consumer product", which means any 298 | tangible personal property which is normally used for personal, family, 299 | or household purposes, or (2) anything designed or sold for incorporation 300 | into a dwelling. In determining whether a product is a consumer product, 301 | doubtful cases shall be resolved in favor of coverage. For a particular 302 | product received by a particular user, "normally used" refers to a 303 | typical or common use of that class of product, regardless of the status 304 | of the particular user or of the way in which the particular user 305 | actually uses, or expects or is expected to use, the product. A product 306 | is a consumer product regardless of whether the product has substantial 307 | commercial, industrial or non-consumer uses, unless such uses represent 308 | the only significant mode of use of the product. 309 | 310 | "Installation Information" for a User Product means any methods, 311 | procedures, authorization keys, or other information required to install 312 | and execute modified versions of a covered work in that User Product from 313 | a modified version of its Corresponding Source. The information must 314 | suffice to ensure that the continued functioning of the modified object 315 | code is in no case prevented or interfered with solely because 316 | modification has been made. 317 | 318 | If you convey an object code work under this section in, or with, or 319 | specifically for use in, a User Product, and the conveying occurs as 320 | part of a transaction in which the right of possession and use of the 321 | User Product is transferred to the recipient in perpetuity or for a 322 | fixed term (regardless of how the transaction is characterized), the 323 | Corresponding Source conveyed under this section must be accompanied 324 | by the Installation Information. But this requirement does not apply 325 | if neither you nor any third party retains the ability to install 326 | modified object code on the User Product (for example, the work has 327 | been installed in ROM). 328 | 329 | The requirement to provide Installation Information does not include a 330 | requirement to continue to provide support service, warranty, or updates 331 | for a work that has been modified or installed by the recipient, or for 332 | the User Product in which it has been modified or installed. Access to a 333 | network may be denied when the modification itself materially and 334 | adversely affects the operation of the network or violates the rules and 335 | protocols for communication across the network. 336 | 337 | Corresponding Source conveyed, and Installation Information provided, 338 | in accord with this section must be in a format that is publicly 339 | documented (and with an implementation available to the public in 340 | source code form), and must require no special password or key for 341 | unpacking, reading or copying. 342 | 343 | 7. Additional Terms. 344 | 345 | "Additional permissions" are terms that supplement the terms of this 346 | License by making exceptions from one or more of its conditions. 347 | Additional permissions that are applicable to the entire Program shall 348 | be treated as though they were included in this License, to the extent 349 | that they are valid under applicable law. If additional permissions 350 | apply only to part of the Program, that part may be used separately 351 | under those permissions, but the entire Program remains governed by 352 | this License without regard to the additional permissions. 353 | 354 | When you convey a copy of a covered work, you may at your option 355 | remove any additional permissions from that copy, or from any part of 356 | it. (Additional permissions may be written to require their own 357 | removal in certain cases when you modify the work.) You may place 358 | additional permissions on material, added by you to a covered work, 359 | for which you have or can give appropriate copyright permission. 360 | 361 | Notwithstanding any other provision of this License, for material you 362 | add to a covered work, you may (if authorized by the copyright holders of 363 | that material) supplement the terms of this License with terms: 364 | 365 | a) Disclaiming warranty or limiting liability differently from the 366 | terms of sections 15 and 16 of this License; or 367 | 368 | b) Requiring preservation of specified reasonable legal notices or 369 | author attributions in that material or in the Appropriate Legal 370 | Notices displayed by works containing it; or 371 | 372 | c) Prohibiting misrepresentation of the origin of that material, or 373 | requiring that modified versions of such material be marked in 374 | reasonable ways as different from the original version; or 375 | 376 | d) Limiting the use for publicity purposes of names of licensors or 377 | authors of the material; or 378 | 379 | e) Declining to grant rights under trademark law for use of some 380 | trade names, trademarks, or service marks; or 381 | 382 | f) Requiring indemnification of licensors and authors of that 383 | material by anyone who conveys the material (or modified versions of 384 | it) with contractual assumptions of liability to the recipient, for 385 | any liability that these contractual assumptions directly impose on 386 | those licensors and authors. 387 | 388 | All other non-permissive additional terms are considered "further 389 | restrictions" within the meaning of section 10. If the Program as you 390 | received it, or any part of it, contains a notice stating that it is 391 | governed by this License along with a term that is a further 392 | restriction, you may remove that term. If a license document contains 393 | a further restriction but permits relicensing or conveying under this 394 | License, you may add to a covered work material governed by the terms 395 | of that license document, provided that the further restriction does 396 | not survive such relicensing or conveying. 397 | 398 | If you add terms to a covered work in accord with this section, you 399 | must place, in the relevant source files, a statement of the 400 | additional terms that apply to those files, or a notice indicating 401 | where to find the applicable terms. 402 | 403 | Additional terms, permissive or non-permissive, may be stated in the 404 | form of a separately written license, or stated as exceptions; 405 | the above requirements apply either way. 406 | 407 | 8. Termination. 408 | 409 | You may not propagate or modify a covered work except as expressly 410 | provided under this License. Any attempt otherwise to propagate or 411 | modify it is void, and will automatically terminate your rights under 412 | this License (including any patent licenses granted under the third 413 | paragraph of section 11). 414 | 415 | However, if you cease all violation of this License, then your 416 | license from a particular copyright holder is reinstated (a) 417 | provisionally, unless and until the copyright holder explicitly and 418 | finally terminates your license, and (b) permanently, if the copyright 419 | holder fails to notify you of the violation by some reasonable means 420 | prior to 60 days after the cessation. 421 | 422 | Moreover, your license from a particular copyright holder is 423 | reinstated permanently if the copyright holder notifies you of the 424 | violation by some reasonable means, this is the first time you have 425 | received notice of violation of this License (for any work) from that 426 | copyright holder, and you cure the violation prior to 30 days after 427 | your receipt of the notice. 428 | 429 | Termination of your rights under this section does not terminate the 430 | licenses of parties who have received copies or rights from you under 431 | this License. If your rights have been terminated and not permanently 432 | reinstated, you do not qualify to receive new licenses for the same 433 | material under section 10. 434 | 435 | 9. Acceptance Not Required for Having Copies. 436 | 437 | You are not required to accept this License in order to receive or 438 | run a copy of the Program. Ancillary propagation of a covered work 439 | occurring solely as a consequence of using peer-to-peer transmission 440 | to receive a copy likewise does not require acceptance. However, 441 | nothing other than this License grants you permission to propagate or 442 | modify any covered work. These actions infringe copyright if you do 443 | not accept this License. Therefore, by modifying or propagating a 444 | covered work, you indicate your acceptance of this License to do so. 445 | 446 | 10. Automatic Licensing of Downstream Recipients. 447 | 448 | Each time you convey a covered work, the recipient automatically 449 | receives a license from the original licensors, to run, modify and 450 | propagate that work, subject to this License. You are not responsible 451 | for enforcing compliance by third parties with this License. 452 | 453 | An "entity transaction" is a transaction transferring control of an 454 | organization, or substantially all assets of one, or subdividing an 455 | organization, or merging organizations. If propagation of a covered 456 | work results from an entity transaction, each party to that 457 | transaction who receives a copy of the work also receives whatever 458 | licenses to the work the party's predecessor in interest had or could 459 | give under the previous paragraph, plus a right to possession of the 460 | Corresponding Source of the work from the predecessor in interest, if 461 | the predecessor has it or can get it with reasonable efforts. 462 | 463 | You may not impose any further restrictions on the exercise of the 464 | rights granted or affirmed under this License. For example, you may 465 | not impose a license fee, royalty, or other charge for exercise of 466 | rights granted under this License, and you may not initiate litigation 467 | (including a cross-claim or counterclaim in a lawsuit) alleging that 468 | any patent claim is infringed by making, using, selling, offering for 469 | sale, or importing the Program or any portion of it. 470 | 471 | 11. Patents. 472 | 473 | A "contributor" is a copyright holder who authorizes use under this 474 | License of the Program or a work on which the Program is based. The 475 | work thus licensed is called the contributor's "contributor version". 476 | 477 | A contributor's "essential patent claims" are all patent claims 478 | owned or controlled by the contributor, whether already acquired or 479 | hereafter acquired, that would be infringed by some manner, permitted 480 | by this License, of making, using, or selling its contributor version, 481 | but do not include claims that would be infringed only as a 482 | consequence of further modification of the contributor version. For 483 | purposes of this definition, "control" includes the right to grant 484 | patent sublicenses in a manner consistent with the requirements of 485 | this License. 486 | 487 | Each contributor grants you a non-exclusive, worldwide, royalty-free 488 | patent license under the contributor's essential patent claims, to 489 | make, use, sell, offer for sale, import and otherwise run, modify and 490 | propagate the contents of its contributor version. 491 | 492 | In the following three paragraphs, a "patent license" is any express 493 | agreement or commitment, however denominated, not to enforce a patent 494 | (such as an express permission to practice a patent or covenant not to 495 | sue for patent infringement). To "grant" such a patent license to a 496 | party means to make such an agreement or commitment not to enforce a 497 | patent against the party. 498 | 499 | If you convey a covered work, knowingly relying on a patent license, 500 | and the Corresponding Source of the work is not available for anyone 501 | to copy, free of charge and under the terms of this License, through a 502 | publicly available network server or other readily accessible means, 503 | then you must either (1) cause the Corresponding Source to be so 504 | available, or (2) arrange to deprive yourself of the benefit of the 505 | patent license for this particular work, or (3) arrange, in a manner 506 | consistent with the requirements of this License, to extend the patent 507 | license to downstream recipients. "Knowingly relying" means you have 508 | actual knowledge that, but for the patent license, your conveying the 509 | covered work in a country, or your recipient's use of the covered work 510 | in a country, would infringe one or more identifiable patents in that 511 | country that you have reason to believe are valid. 512 | 513 | If, pursuant to or in connection with a single transaction or 514 | arrangement, you convey, or propagate by procuring conveyance of, a 515 | covered work, and grant a patent license to some of the parties 516 | receiving the covered work authorizing them to use, propagate, modify 517 | or convey a specific copy of the covered work, then the patent license 518 | you grant is automatically extended to all recipients of the covered 519 | work and works based on it. 520 | 521 | A patent license is "discriminatory" if it does not include within 522 | the scope of its coverage, prohibits the exercise of, or is 523 | conditioned on the non-exercise of one or more of the rights that are 524 | specifically granted under this License. You may not convey a covered 525 | work if you are a party to an arrangement with a third party that is 526 | in the business of distributing software, under which you make payment 527 | to the third party based on the extent of your activity of conveying 528 | the work, and under which the third party grants, to any of the 529 | parties who would receive the covered work from you, a discriminatory 530 | patent license (a) in connection with copies of the covered work 531 | conveyed by you (or copies made from those copies), or (b) primarily 532 | for and in connection with specific products or compilations that 533 | contain the covered work, unless you entered into that arrangement, 534 | or that patent license was granted, prior to 28 March 2007. 535 | 536 | Nothing in this License shall be construed as excluding or limiting 537 | any implied license or other defenses to infringement that may 538 | otherwise be available to you under applicable patent law. 539 | 540 | 12. No Surrender of Others' Freedom. 541 | 542 | If conditions are imposed on you (whether by court order, agreement or 543 | otherwise) that contradict the conditions of this License, they do not 544 | excuse you from the conditions of this License. If you cannot convey a 545 | covered work so as to satisfy simultaneously your obligations under this 546 | License and any other pertinent obligations, then as a consequence you may 547 | not convey it at all. For example, if you agree to terms that obligate you 548 | to collect a royalty for further conveying from those to whom you convey 549 | the Program, the only way you could satisfy both those terms and this 550 | License would be to refrain entirely from conveying the Program. 551 | 552 | 13. Use with the GNU Affero General Public License. 553 | 554 | Notwithstanding any other provision of this License, you have 555 | permission to link or combine any covered work with a work licensed 556 | under version 3 of the GNU Affero General Public License into a single 557 | combined work, and to convey the resulting work. The terms of this 558 | License will continue to apply to the part which is the covered work, 559 | but the special requirements of the GNU Affero General Public License, 560 | section 13, concerning interaction through a network will apply to the 561 | combination as such. 562 | 563 | 14. Revised Versions of this License. 564 | 565 | The Free Software Foundation may publish revised and/or new versions of 566 | the GNU General Public License from time to time. Such new versions will 567 | be similar in spirit to the present version, but may differ in detail to 568 | address new problems or concerns. 569 | 570 | Each version is given a distinguishing version number. If the 571 | Program specifies that a certain numbered version of the GNU General 572 | Public License "or any later version" applies to it, you have the 573 | option of following the terms and conditions either of that numbered 574 | version or of any later version published by the Free Software 575 | Foundation. If the Program does not specify a version number of the 576 | GNU General Public License, you may choose any version ever published 577 | by the Free Software Foundation. 578 | 579 | If the Program specifies that a proxy can decide which future 580 | versions of the GNU General Public License can be used, that proxy's 581 | public statement of acceptance of a version permanently authorizes you 582 | to choose that version for the Program. 583 | 584 | Later license versions may give you additional or different 585 | permissions. However, no additional obligations are imposed on any 586 | author or copyright holder as a result of your choosing to follow a 587 | later version. 588 | 589 | 15. Disclaimer of Warranty. 590 | 591 | THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY 592 | APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT 593 | HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY 594 | OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, 595 | THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 596 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM 597 | IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF 598 | ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 599 | 600 | 16. Limitation of Liability. 601 | 602 | IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 603 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS 604 | THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY 605 | GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE 606 | USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF 607 | DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD 608 | PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), 609 | EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF 610 | SUCH DAMAGES. 611 | 612 | 17. Interpretation of Sections 15 and 16. 613 | 614 | If the disclaimer of warranty and limitation of liability provided 615 | above cannot be given local legal effect according to their terms, 616 | reviewing courts shall apply local law that most closely approximates 617 | an absolute waiver of all civil liability in connection with the 618 | Program, unless a warranty or assumption of liability accompanies a 619 | copy of the Program in return for a fee. 620 | 621 | END OF TERMS AND CONDITIONS 622 | 623 | How to Apply These Terms to Your New Programs 624 | 625 | If you develop a new program, and you want it to be of the greatest 626 | possible use to the public, the best way to achieve this is to make it 627 | free software which everyone can redistribute and change under these terms. 628 | 629 | To do so, attach the following notices to the program. It is safest 630 | to attach them to the start of each source file to most effectively 631 | state the exclusion of warranty; and each file should have at least 632 | the "copyright" line and a pointer to where the full notice is found. 633 | 634 | 635 | Copyright (C) 636 | 637 | This program is free software: you can redistribute it and/or modify 638 | it under the terms of the GNU General Public License as published by 639 | the Free Software Foundation, either version 3 of the License, or 640 | (at your option) any later version. 641 | 642 | This program is distributed in the hope that it will be useful, 643 | but WITHOUT ANY WARRANTY; without even the implied warranty of 644 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 645 | GNU General Public License for more details. 646 | 647 | You should have received a copy of the GNU General Public License 648 | along with this program. If not, see . 649 | 650 | Also add information on how to contact you by electronic and paper mail. 651 | 652 | If the program does terminal interaction, make it output a short 653 | notice like this when it starts in an interactive mode: 654 | 655 | Copyright (C) 656 | This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 657 | This is free software, and you are welcome to redistribute it 658 | under certain conditions; type `show c' for details. 659 | 660 | The hypothetical commands `show w' and `show c' should show the appropriate 661 | parts of the General Public License. Of course, your program's commands 662 | might be different; for a GUI interface, you would use an "about box". 663 | 664 | You should also get your employer (if you work as a programmer) or school, 665 | if any, to sign a "copyright disclaimer" for the program, if necessary. 666 | For more information on this, and how to apply and follow the GNU GPL, see 667 | . 668 | 669 | The GNU General Public License does not permit incorporating your program 670 | into proprietary programs. If your program is a subroutine library, you 671 | may consider it more useful to permit linking proprietary applications with 672 | the library. If this is what you want to do, use the GNU Lesser General 673 | Public License instead of this License. But first, please read 674 | . 675 | -------------------------------------------------------------------------------- /mason.el: -------------------------------------------------------------------------------- 1 | ;;; mason.el --- Package managers for LSP, DAP, linters, and more -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2025 Dimas Firmansyah 4 | 5 | ;; Author: Dimas Firmansyah 6 | ;; Version: 1.0.0 7 | ;; Homepage: https://github.com/deirn/mason.el 8 | ;; Package-Requires: ((emacs "30.1") (s "1.13.0")) 9 | ;; Keywords: tools lsp installer 10 | ;; This file is not part of GNU Emacs. 11 | 12 | ;; This program is free software; you can redistribute it and/or modify 13 | ;; it under the terms of the GNU General Public License as published by 14 | ;; the Free Software Foundation, either version 3 of the License, or 15 | ;; (at your option) any later version. 16 | 17 | ;; This program is distributed in the hope that it will be useful, 18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 | ;; GNU General Public License for more details. 21 | 22 | ;; You should have received a copy of the GNU General Public License 23 | ;; along with this program. If not, see . 24 | 25 | ;;; Commentary: 26 | 27 | ;; Installer for LSP servers, DAP servers, linters, and formatters. 28 | ;; Based on mason.nvim. https://github.com/mason-org/mason.nvim 29 | 30 | ;;; Code: 31 | 32 | (require 'ansi-color) 33 | (require 'cl-lib) 34 | (require 'json) 35 | (require 'seq) 36 | (require 's) 37 | (require 'url-parse) 38 | 39 | (require 'mason-basic) 40 | 41 | (defcustom mason-dir (expand-file-name "mason" user-emacs-directory) 42 | "Directory where to find mason files." 43 | :type 'directory :group 'mason) 44 | 45 | (defcustom mason-registry-refresh-time (* 60 60 24 7) 46 | "How long in seconds before trying to refresh the registry. 47 | Defaults to 1 week. Set to 0 or less to disable automatic refresh. 48 | This value is checked on every `mason-ensure' call." 49 | :type 'integer :group 'mason) 50 | 51 | (defcustom mason-registries 52 | '(("mason" . "https://github.com/mason-org/mason-registry/releases/latest/download/registry.json.zip")) 53 | "Alist of registry name and registry json archive link." 54 | :type '(alist :key-type string :value-type string) 55 | :group 'mason) 56 | 57 | (defcustom mason-show-deprecated nil 58 | "Whether to show deprecated packages." 59 | :type 'boolean :group 'mason) 60 | 61 | (defcustom mason-moving-versions 62 | (list (rx bos "nightly" eos) 63 | (rx bos "latest" eos)) 64 | "List of regexp strings for versions that will be marked as always updatable. 65 | Will be matched case-insensitively." 66 | :type '(repeat regexp) 67 | :group 'mason) 68 | 69 | 70 | ;; Keybinds 71 | 72 | (defmacro mason--keymap! (map &rest binds) 73 | "Define a keymap MAP with BINDS." 74 | (declare (indent defun)) 75 | (unless (eq (% (length binds) 2) 0) 76 | (error "BINDS must be even")) 77 | `(progn 78 | (defconst ,map (make-sparse-keymap)) 79 | ,@(cl-loop for (k v) on binds by #'cddr 80 | collect `(define-key ,map ,(if (stringp k) `(kbd ,k) k) ',v)))) 81 | 82 | (defun mason--use-local-map (map) 83 | "Call `use-local-map' with MAP. 84 | If Evil exists, also call `evil-local-set-key'." 85 | (use-local-map map) 86 | (when (functionp 'evil-local-set-key) 87 | (map-keymap 88 | (lambda (event fn) 89 | (evil-local-set-key 'normal (vector event) fn)) 90 | map))) 91 | 92 | (defconst mason--help-buffer "*mason-help*") 93 | (mason--keymap! mason-help-map "q" kill-buffer-and-window) 94 | (define-derived-mode mason-help-mode tabulated-list-mode "Mason Help" :interactive nil) 95 | 96 | (defun mason--help-map (map &optional kill) 97 | "Show (or KILL) help for MAP symbol." 98 | (let* ((buf-name (format "*mason help for %s*" (symbol-name map))) 99 | (map (symbol-value map)) 100 | (buf (get-buffer buf-name)) 101 | (key-len 3) 102 | mapper entries) 103 | (cond 104 | ((or buf (and kill buf)) (kill-buffer buf)) 105 | ((not kill) 106 | (setq buf (get-buffer-create buf-name)) 107 | (with-current-buffer buf 108 | (mason-help-mode) 109 | (read-only-mode -1) 110 | (erase-buffer) 111 | (setq mapper 112 | (lambda (event function &optional prefix) 113 | (let ((key (key-description (vector event)))) 114 | (when prefix (setq key (concat prefix " " key))) 115 | (if (keymapp function) 116 | (map-keymap (lambda (e f) (funcall mapper e f key)) function) 117 | (let* ((s (documentation function)) 118 | (key (propertize key 'face 'help-key-binding)) 119 | (doc (if (not (string-match "\\`\\(.*\\)\\.?$*" s)) s 120 | (string-trim (match-string 1 s))))) 121 | (setq key-len (max key-len (length key))) 122 | (push (list key (vector key doc)) entries)))))) 123 | (map-keymap mapper map) 124 | (setq tabulated-list-format (vector `("Key" ,key-len nil . (:pad-right 2)) 125 | '("Description" 0 nil)) 126 | tabulated-list-entries entries) 127 | (tabulated-list-init-header) 128 | (tabulated-list-print) 129 | (read-only-mode 1) 130 | (mason--use-local-map mason-help-map) 131 | (pop-to-buffer buf '((display-buffer-reuse-window display-buffer-in-side-window) 132 | (post-command-select-window . nil) 133 | (side . right) 134 | (window-width . 0.25)))))))) 135 | 136 | 137 | ;; Utility Functions 138 | 139 | (defmacro mason--run-at-main (&rest body) 140 | "Run BODY at main thread." 141 | (declare (indent defun)) 142 | `(let ((fn (lambda () ,@body))) 143 | (if mason-dry-run 144 | (funcall fn) 145 | (run-at-time 0 nil fn)))) 146 | 147 | (defmacro mason--wrap-error (fn success &rest body) 148 | "Call FN with argument nil when BODY errors. 149 | If SUCCESS, also call FN with argument t when BODY succeeded." 150 | (declare (indent defun)) 151 | `(let* ((fn ,fn) 152 | (fnp (functionp fn))) 153 | (condition-case err 154 | (progn 155 | ,@body 156 | ,(when success 157 | `(when fnp (funcall fn t)))) 158 | ((error debug) 159 | (mason--error "%s" (error-message-string err)) 160 | (when fnp (funcall fn nil)))))) 161 | 162 | (defmacro mason--wrap-error-at-main (fn success &rest body) 163 | "`mason--wrap-error' with `mason--run-at-main'. 164 | FN SUCCESS BODY." 165 | (declare (indent defun)) 166 | `(let ((fn ,fn)) 167 | (mason--wrap-error 168 | (lambda (x) 169 | (when (functionp fn) (run-at-time 0 nil (lambda () (funcall fn x))))) 170 | ,success ,@body))) 171 | 172 | (defun mason--process-filter (proc string) 173 | "PROC STRING filter that logs the output." 174 | (let* ((mason--log-pkg (process-get proc :pkg)) 175 | (cmd (file-name-nondirectory (car (process-command proc)))) 176 | (id (process-id proc)) 177 | (acc (or (process-get proc :accumulator) "")) 178 | (acc (concat acc string)) 179 | line) 180 | (while (string-match "^\\(.*\\)\n+" acc) 181 | (setq line (match-string 1 acc) 182 | acc (string-remove-prefix (match-string 0 acc) acc)) 183 | (unless (string-empty-p line) 184 | (mason--info "%s(%d): %s" cmd id line))) 185 | (process-put proc :accumulator acc))) 186 | 187 | (cl-defun mason--process (cmd &optional &key env cwd filter then) 188 | "Run process CMD asynchronously. 189 | See `make-process' for CMD and FILTER. 190 | ENV is alist of environment variable to add to `process-environment'. 191 | CWD is the working directory. 192 | THEN is a function to call after process succeed. 193 | THEN needs to accept a parameter, indicating if the process succeeded." 194 | (declare (indent defun)) 195 | (let ((prog (car cmd)) 196 | (msg (mapconcat #'mason--quote cmd " ")) 197 | (process-environment process-environment)) 198 | (when env 199 | (dolist (e (nreverse env)) 200 | (let ((k (car e)) (v (cdr e))) 201 | (push (concat k "=" v) process-environment) 202 | (setq msg (concat k "=" (mason--quote v) " " msg))))) 203 | (setq msg (if cwd (format-message "Calling `%s' at `%s'" msg cwd) 204 | (format-message "Calling `%s'" msg))) 205 | (when mason-dry-run 206 | (mason--info "%s" msg) 207 | (when (functionp then) (funcall then t)) 208 | (cl-return-from mason--process nil)) 209 | (unless (executable-find prog) 210 | (error "Missing program `%s'" prog)) 211 | (let* ((default-directory (or (when cwd (expand-file-name cwd)) 212 | default-directory)) 213 | (proc (make-process 214 | :name "mason" 215 | :filter 216 | (if (not (functionp filter)) #'mason--process-filter 217 | (lambda (proc string) 218 | (funcall filter proc string) 219 | (mason--process-filter proc string))) 220 | :command cmd 221 | :sentinel 222 | (lambda (proc _) 223 | (when (memq (process-status proc) '(exit signal)) 224 | (let* ((cmd (file-name-nondirectory (car (process-command proc)))) 225 | (id (process-id proc)) 226 | (status (process-exit-status proc)) 227 | (success (zerop status)) 228 | (mason--log-pkg (process-get proc :pkg))) 229 | (if success (mason--info "%s(%s): Finished with status %s" cmd id status) 230 | (mason--error "%s(%s): Failed with status %s" cmd id status)) 231 | (when (functionp then) 232 | (funcall then success)))))))) 233 | (process-put proc :pkg mason--log-pkg) 234 | (mason--info "%s(%s): %s" (file-name-nondirectory (car cmd)) (process-id proc) msg)))) 235 | 236 | (cl-defmacro mason--process2 (cmd &optional &key env cwd filter then) 237 | "To be used as `mason--process' :then. 238 | See `mason--process' for CMD ENV CWD FILTER THEN." 239 | (declare (indent defun)) 240 | `(lambda (success) 241 | (if (not success) (funcall ,then nil) 242 | (mason--process ,cmd :env ,env :cwd ,cwd :filter ,filter :then ,then)))) 243 | 244 | (defconst mason--cmd-load-path (file-name-directory (or load-file-name buffer-file-name))) 245 | 246 | ;; copied from dirvish 247 | (defconst mason--emacs-bin 248 | (cond 249 | ((and invocation-directory invocation-name) 250 | (expand-file-name (concat (file-name-as-directory invocation-directory) invocation-name))) 251 | ((eq system-type 'darwin) 252 | "/Applications/Emacs.app/Contents/MacOS/Emacs") 253 | (t "emacs"))) 254 | 255 | (defun mason--emacs-cmd (&rest body) 256 | "Run BODY in a separate Emacs process. 257 | To be used with `mason--process' and `mason--process-sync'." 258 | (declare (indent defun)) 259 | (list mason--emacs-bin "-Q" "--batch" 260 | "-L" mason--cmd-load-path 261 | "--eval" 262 | (prin1-to-string 263 | `(progn 264 | (require 'mason-basic) 265 | (setq mason-dry-run ,mason-dry-run) 266 | ,@body)))) 267 | 268 | (defvar mason--target nil) 269 | 270 | (defun mason--update-target (then) 271 | "Update target and call THEN." 272 | (let* ((reg-dir (mason--expand-child-file-name "registry" mason-dir)) 273 | (out-file (mason--expand-child-file-name "target" reg-dir)) 274 | output) 275 | (when (file-exists-p out-file) 276 | (setq mason--target (ignore-errors (mason--read-data out-file)))) 277 | (if (not (null mason--target)) 278 | (funcall then) 279 | (mason--process 280 | (mason--emacs-cmd '(message "%S" (mason--get-target))) 281 | :filter (lambda (_ o) (setq output (concat output o))) 282 | :then 283 | (lambda (success) 284 | (if (not success) (error "Updating target failed") 285 | (setq mason--target (read output)) 286 | (make-directory reg-dir t) 287 | (with-temp-file out-file 288 | (insert output)) 289 | (funcall then))))))) 290 | 291 | (defun mason--target-match (str) 292 | "Return non nil when target STR matches current target." 293 | (let* ((os (nth 0 mason--target)) 294 | (arch (nth 1 mason--target)) 295 | (libc (nth 2 mason--target)) 296 | (s-split (s-split-up-to "_" str 3 'omit-nulls)) 297 | (s-os (nth 0 s-split)) 298 | (s-arch (nth 1 s-split)) 299 | (s-libc (nth 2 s-split)) 300 | (match (or s-os s-arch s-libc))) 301 | (when s-os (setq match (and match (member s-os os)))) 302 | (when s-arch (setq match (and match (equal arch s-arch)))) 303 | (when s-libc (setq match (and match (equal libc s-libc)))) 304 | match)) 305 | 306 | (defun mason--merge-hash (&rest tables) 307 | "Merge hash TABLES to one." 308 | (let ((h (mason--make-hash))) 309 | (dolist (table tables) 310 | (maphash (lambda (k v) (puthash k v h)) table)) 311 | h)) 312 | 313 | (defun mason--hash-keys (table) 314 | "Get list of keys from TABLE." 315 | (when table 316 | (let (keys) 317 | (maphash (lambda (k _v) (push k keys)) table) 318 | (nreverse keys)))) 319 | 320 | (defun mason--expect-hash-key (table &rest keys) 321 | "Throw an error if hash TABLE key not in KEYS." 322 | (maphash 323 | (lambda (k _v) 324 | (unless (member k keys) 325 | (error "Unexpected key `%s' in table `%s'" 326 | k (json-encode table)))) 327 | table)) 328 | 329 | (defun mason--parse-purl (string) 330 | "Parse a PURL STRING. 331 | Returns a hash table of members: 332 | - raw 333 | - scheme 334 | - type 335 | - namespace 336 | - name 337 | - version 338 | - qualifiers 339 | - subpath 340 | 341 | https://github.com/package-url/purl-spec" 342 | (let* ((url (url-generic-parse-url string)) 343 | (path-and-query (url-path-and-query url)) 344 | (scheme (url-type url)) 345 | (path (car path-and-query)) 346 | type name namespace version 347 | (q-str (cdr path-and-query)) 348 | qualifiers 349 | (subpath (url-target url)) 350 | purl) 351 | (let ((tn-split (s-split-up-to "/" path 1 t))) 352 | (unless (length= tn-split 2) 353 | (error "Failed to parse PURL: `%s' does not contain type and name" string)) 354 | (setq type (nth 0 tn-split) 355 | name (nth 1 tn-split))) 356 | (let ((ns-split (s-split-up-to "/" name 1 t))) 357 | (when (length= ns-split 2) 358 | (setq namespace (nth 0 ns-split) 359 | name (nth 1 ns-split)))) 360 | (let ((nv-split (s-split-up-to "@" name 1 t))) 361 | (setq name (nth 0 nv-split) 362 | version (nth 1 nv-split))) 363 | (setq purl (mason--make-hash 364 | "raw" (when string (url-unhex-string string)) 365 | "scheme" (when scheme (url-unhex-string scheme)) 366 | "type" (when type (url-unhex-string type)) 367 | "namespace" (when namespace (url-unhex-string namespace)) 368 | "name" (when name (url-unhex-string name)) 369 | "version" (when version (url-unhex-string version)) 370 | "qualifiers" nil 371 | "subpath" (when subpath (url-unhex-string subpath)))) 372 | (when q-str 373 | (setq qualifiers (mason--make-hash)) 374 | (dolist (e (url-parse-query-string q-str)) 375 | (puthash (url-unhex-string (nth 0 e)) (url-unhex-string (nth 1 e)) qualifiers)) 376 | (puthash "qualifiers" qualifiers purl)) 377 | purl)) 378 | 379 | (defconst mason--bin-regexp 380 | ;; [type:]path/to/bin 381 | (concat "^" 382 | "\\(" ; optional type 383 | "\\([A-Za-z0-9_-]+\\)" 384 | ":" 385 | "\\)?" 386 | "\\(" ; path/to/bin 387 | "[A-Za-z0-9_.-]" ; disallow absolute path 388 | "[A-Za-z0-9_./-]+" 389 | "\\)" 390 | "$")) 391 | 392 | (defun mason--parse-bin (bin) 393 | "Parse a BIN." 394 | (if (string-match mason--bin-regexp bin) 395 | (mason--make-hash 396 | "type" (or (match-string 2 bin) "path") 397 | "path" (match-string 3 bin)) 398 | (error "Unsupported bin `%s'" bin))) 399 | 400 | (defun mason--unquote-string-or-nil (s) 401 | "If S is a double-quoted string, return its unescaped contents; otherwise nil." 402 | (when (and (stringp s) 403 | (>= (length s) 2) 404 | (eq (aref s 0) ?\") 405 | (eq (aref s (1- (length s))) ?\")) 406 | (let ((inner (substring s 1 (1- (length s))))) 407 | (replace-regexp-in-string 408 | "\\\\[\\\"\\\\ntbr]" ; match backslash escapes 409 | (lambda (esc) 410 | (pcase (aref esc 1) 411 | (?\" "\"") 412 | (?\\ "\\") 413 | (?n "\n") 414 | (?t "\t") 415 | (?b "\b") 416 | (?r "\r") 417 | (_ (substring esc 1)))) 418 | inner)))) 419 | 420 | (defun mason--unquote-string (s) 421 | "If S is double-quoted, return its unescaped contents; otherwise return S." 422 | (or (mason--unquote-string-or-nil s) s)) 423 | 424 | (cl-defun mason--make-shell (path content &optional &key overwrite env) 425 | "Make a shell script at PATH with CONTENT. 426 | Delete existing file if OVERWRITE is not nil. 427 | 428 | CONTENT can be either string or list of string, in which it 429 | will get concatenated with `mason--quote'. 430 | 431 | ENV is alist of additional environment variable to set. 432 | Returns the modified PATH, added with .bat extension in Windows." 433 | (let* ((windows (mason--is-windows t)) 434 | (path (if windows (concat path ".bat") path)) 435 | (c (if (stringp content) content (mapconcat #'mason--quote content " ")))) 436 | (unless mason-dry-run 437 | (make-directory (file-name-parent-directory path) t) 438 | (when (and overwrite (file-exists-p path)) 439 | (mason--delete-file path)) 440 | (with-temp-file path 441 | (cond 442 | (windows 443 | (insert "@echo off\r\n" 444 | "setlocal enabledelayedexpansion\r\n" 445 | "set \"args=\"\r\n" 446 | "for %%A in (%*) do (\r\n" 447 | " set \"args=!args! \"%%~A\"\"\r\n" 448 | ")\r\n") 449 | (dolist (e (nreverse env)) 450 | (insert "set " "\"" (car e) "=" (cdr e) "\"\r\n")) 451 | (insert (replace-regexp-in-string "\n" "\r\n" c) "\r\n")) 452 | ;; unix 453 | (t (insert "#!/usr/bin/env bash\n") 454 | (dolist (e (nreverse env)) 455 | (insert "export " (car e) "=" (mason--quote (cdr e) 'always) "\n")) 456 | (insert c "\n")))) 457 | (unless windows 458 | (set-file-modes path #o755))) 459 | (mason--info "Made shell script at `%s'" path) 460 | path)) 461 | 462 | (defun mason--shell-env (env) 463 | "Return shell script ENV reference." 464 | (if (mason--is-windows t) (concat "%" env "%") 465 | (concat "$" env))) 466 | 467 | (defun mason--shell-exec () 468 | "Return exec on Unix." 469 | (if (mason--is-windows) "" "exec")) 470 | 471 | (defun mason--shell-args () 472 | "Arguments expansion for `mason--make-shell', $@ in Unix." 473 | (if (mason--is-windows) "!args!" "\"$@\"")) 474 | 475 | (defun mason--shell-cmd (path) 476 | "Return the shell command for running script at PATH. 477 | To be used with `mason--process' or `mason--process-sync'." 478 | (let* ((windows (mason--is-windows t)) 479 | (shell (if windows '("cmd.exe" "/c") '("bash" "-lc")))) 480 | (when windows 481 | (unless (string= "bat" (file-name-extension path)) 482 | (setq path (concat path ".bat"))) 483 | (setq path (subst-char-in-string ?/ ?\\ path))) 484 | `(,@shell ,path))) 485 | 486 | (defun mason--link (path target &optional overwrite) 487 | "Create a symbolic link at PATH to TARGET. 488 | Delete existing file if OVERWRITE is not nil." 489 | (let* ((parent (file-name-parent-directory path)) 490 | (target (file-relative-name target parent))) 491 | (unless mason-dry-run 492 | (make-directory parent t) 493 | (when (and overwrite (file-exists-p path)) 494 | (mason--delete-file path)) 495 | (make-symbolic-link target path)) 496 | (mason--info "Made symlink at `%s' that links to `%s'" path target))) 497 | 498 | 499 | ;; Expression Expanders 500 | 501 | (defconst mason--var "[A-Za-z0-9_.-]+") 502 | (defconst mason--var-w (concat "^" mason--var "$")) 503 | (defconst mason--str1 "'\\(.*\\)'") 504 | (defconst mason--str1-w (concat "^" mason--str1 "$")) 505 | (defconst mason--str2 "\"\\(.*\\)\"") 506 | (defconst mason--str2-w (concat "^" mason--str2 "$")) 507 | 508 | (defconst mason--pipe-fun (concat "^\\(" mason--var "\\)" 509 | "\\(\s+\\(.*\\)\\)?$" ; optional arguments 510 | )) 511 | (defconst mason--pipe-arg (concat "^\\(" mason--var 512 | "\\|" mason--str1 513 | "\\|" mason--str2 514 | "\\)" 515 | "\\(\s+\\|$\\)" ; spaces or end string 516 | )) 517 | 518 | (defun mason--pipe-to-proc (exp) 519 | "Convert pipe EXP to procedural-style expression." 520 | (let* ((pipes (mapcar #'string-trim (split-string exp "|" 'omit-nills)))) 521 | (dotimes (i (- (length pipes) 1)) 522 | (let ((this (nth i pipes)) 523 | (next (nth (1+ i) pipes))) 524 | (cond 525 | ((string-suffix-p ")" next) 526 | (setq next (string-trim (string-remove-suffix ")" next))) 527 | (if (string-suffix-p "(" next) 528 | (setq next (concat next this ")")) 529 | (setq next (concat next ", " this ")")))) 530 | ((string-match mason--pipe-fun next) 531 | (let* ((fn (match-string 1 next)) 532 | (args-str (match-string 3 next)) 533 | (rest args-str) 534 | args) 535 | (when (and args-str (not (string-empty-p args-str))) 536 | (while (not (string-empty-p rest)) 537 | (unless (string-match mason--pipe-arg rest) 538 | (error "Failed to parse rest of function args `%s'" rest)) 539 | (push (match-string 1 rest) args) 540 | (setq rest (string-remove-prefix (match-string 0 rest) rest))) 541 | (setq args (nreverse args))) 542 | (setq next (concat fn "(" 543 | (when args (concat (mapconcat #'identity args ", ") ", ")) 544 | this ")")))) 545 | (t (error "Invalid expression `%s'" next))) 546 | (setf (nth (1+ i) pipes) next))) 547 | (car (last pipes)))) 548 | 549 | (defconst mason--proc-fun (concat "\\(" mason--var "\\)\s*(\\(.*\\))")) 550 | (defconst mason--proc-fun-w (concat "^" mason--proc-fun "$")) 551 | (defconst mason--proc-arg (concat "^\\(" mason--var 552 | "\\|" mason--proc-fun 553 | "\\|" mason--str1 554 | "\\|" mason--str2 555 | "\\)\s*" 556 | "\\(,\s*\\|$\\)" ; comma space or end string 557 | )) 558 | 559 | (defun mason--proc-to-sexp (exp &optional transformer) 560 | "Convert procedural EXP to s-expression. 561 | TRANSFORMER accepts symbol type and string to transform to sexp." 562 | (setq exp (string-trim exp)) 563 | (cond 564 | ;; function call 565 | ((string-match mason--proc-fun-w exp) 566 | (let* ((fn (match-string 1 exp)) 567 | (args-str (string-trim (match-string 2 exp))) 568 | (rest args-str) 569 | args) 570 | (while (not (string-empty-p rest)) 571 | (unless (string-match mason--proc-arg rest) 572 | (error "Failed to parse rest of function args `%s'" rest)) 573 | (push (match-string 1 rest) args) 574 | (setq rest (string-remove-prefix (match-string 0 rest) rest))) 575 | (setq args (nreverse (mapcar (lambda (e) (mason--proc-to-sexp e transformer)) 576 | args))) 577 | (when (functionp transformer) 578 | (setq fn (funcall transformer 'function fn))) 579 | (concat "(" (mapconcat #'identity (cons fn args) " ") ")"))) 580 | ;; ' string 581 | ((string-match mason--str1-w exp) 582 | (mason--quote (match-string 1 exp) 'always)) 583 | ;; " string, already double-quoted 584 | ((string-match-p mason--str2-w exp) 585 | exp) 586 | ;; variable access 587 | ((string-match-p mason--var-w exp) 588 | (if (functionp transformer) 589 | (funcall transformer 'variable exp) 590 | exp)) 591 | (t (error "Invalid expression `%s'" exp)))) 592 | 593 | (defun mason--pipe-to-sexp (exp &optional transformer) 594 | "Convert pipe EXP to s-expression. 595 | See `mason--proc-to-sexp' for TRANSFORMER." 596 | (mason--proc-to-sexp (mason--pipe-to-proc exp) transformer)) 597 | 598 | (defconst mason--expand-str nil) 599 | (defconst mason--expand-ctx nil) 600 | 601 | (defun mason--expand (str ctx) 602 | "Expand STR according to hash table CTX." 603 | (let* ((mason--expand-str str) 604 | (mason--expand-ctx ctx) 605 | (dollar (replace-regexp-in-string "{{\\([^}]+\\)}}" "${\\1}" str)) 606 | (expanded-str (s-format dollar 607 | (lambda (exp) 608 | (eval (read (mason--pipe-to-sexp exp #'mason--expand-transformer)) t))))) 609 | (unless (string= str expanded-str) 610 | (mason--info "Expanded `%s' to `%s'" str expanded-str)) 611 | expanded-str)) 612 | 613 | (defun mason--expand-transformer (type string) 614 | "TYPE STRING exp transformer for `mason--expand'." 615 | (if (eq type 'variable) 616 | (concat "(mason--expand-variable " (mason--quote string 'always) ")") 617 | (concat "mason--expand-function " (mason--quote string 'always)))) 618 | 619 | (defun mason--expand-function (function &rest args) 620 | "Expand FUNCTION with ARGS." 621 | (let ((a0 (nth 0 args)) 622 | (a1 (nth 1 args))) 623 | (cl-case (intern function) 624 | (take_if_not (if (not a0) a1 "")) 625 | (strip_prefix (string-remove-prefix a0 a1)) 626 | (is_platform (mason--target-match a0)) 627 | (t (error "Unable to expand `%s' unsupported operation `%s'" mason--expand-str function))))) 628 | 629 | (defun mason--expand-variable (var) 630 | "Get expand VAR." 631 | (let ((path (split-string var "\\.")) 632 | (tree mason--expand-ctx)) 633 | (dolist (p path) 634 | (setq tree (when tree (gethash p tree)))) 635 | (unless tree 636 | (mason--warn "Missing variable `%s'" var)) 637 | (or tree ""))) 638 | 639 | 640 | ;; Source Resolvers 641 | 642 | (defconst mason--source-requirements nil) 643 | 644 | (cl-defmacro mason--source! (type 645 | (&key (req nil) 646 | (namespace 'none) 647 | (version 'must) 648 | (qualifiers 'none) 649 | (subpath 'none)) 650 | &rest body) 651 | "Define a mason source resolver for TYPE. 652 | 653 | :REQ key declares external program requirements for 654 | the source. 655 | 656 | These keys declare support for PURL member: 657 | :NAMESPACE none, optional or must, defaults to none 658 | :VERSION none, optional or must, defaults to must 659 | :QUALIFIERS none or (\"q1\" \"q2\"), defaults to none 660 | :SUBPATH none, optional or must, defaults to none 661 | 662 | - If none, ID can not have the member. 663 | - If optional, ID can have the member. 664 | - If must, ID must have the member. 665 | - Special for :qualifiers, if list, ID can only have 666 | qualifiers from the specified list. 667 | 668 | Inside BODY, one can reference: 669 | - NAME is the name of the mason entry. 670 | - ID is the entire `mason--parse-purl' result. 671 | - Members of ID, prefixed with ID- (e.g.) ID-VERSION 672 | - PREFIX is the directory where the package is expected to be installed. 673 | - SOURCE is the entire source hash-table. 674 | - NEXT is the function to call after the process done." 675 | (declare (indent 2)) 676 | (let* ((fn-name (concat "mason--source-" (symbol-name type))) 677 | (values '(none optional must)) 678 | ;; namespace 679 | (p-namespace 680 | (cond 681 | ((eq namespace 'none) 682 | `(when id-namespace 683 | (error "`%s' must not have namespace" id-raw))) 684 | ((eq namespace 'optional) 685 | '(ignore)) 686 | ((eq namespace 'must) 687 | `(unless id-namespace 688 | (error "`%s' must have namespace" id-raw))) 689 | (t (error "`%s': :namespace support must be one of %S" fn-name values)))) 690 | ;; version 691 | (p-version 692 | (cond 693 | ((eq version 'none) 694 | `(when id-version 695 | (error "`%s' must not have version" id-raw))) 696 | ((eq version 'optional) 697 | '(ignore)) 698 | ((eq version 'must) 699 | `(unless id-version 700 | (error "`%s' must have version" id-raw))) 701 | (t (error "`%s': :version support must be one of %S" fn-name values)))) 702 | ;; subpath 703 | (p-subpath 704 | (cond 705 | ((eq subpath 'none) 706 | `(when id-subpath 707 | (error "`%s' must not have subpath" id-raw))) 708 | ((eq subpath 'optional) 709 | '(ignore)) 710 | ((eq subpath 'must) 711 | `(unless id-subpath 712 | (error "`%s' must have subpath" id-raw))) 713 | (t (error "`%s': :subpath support must be one of %S" fn-name values)))) 714 | ;; qualifiers 715 | (p-qualifiers 716 | (cond 717 | ((eq qualifiers 'none) 718 | `(when id-qualifiers 719 | (error "`%s' must not have qualifiers" id-raw))) 720 | ((and (listp qualifiers) (not (seq-empty-p qualifiers))) 721 | `(unless (seq-every-p (lambda (q) (member q m-qualifiers)) (mason--hash-keys id-qualifiers)) 722 | (error "`%s' must only have qualifiers of key %S" id-raw m-qualifiers))) 723 | (t (error "`%s': :qualifiers must be none or list" fn-name))))) 724 | ;; resulting function 725 | `(progn 726 | (push (cons ',type ',req) mason--source-requirements) 727 | (defun ,(intern fn-name) (name prefix id source spec next) 728 | (let* ((m-qualifiers ',qualifiers) 729 | (id-raw (gethash "raw" id)) 730 | (id-scheme (gethash "scheme" id)) 731 | (id-type (gethash "type" id)) 732 | (id-namespace (gethash "namespace" id)) 733 | (id-name (gethash "name" id)) 734 | (id-version (gethash "version" id)) 735 | (id-qualifiers (gethash "qualifiers" id)) 736 | (id-subpath (gethash "subpath" id))) 737 | (ignore name id source spec m-qualifiers 738 | id-raw id-scheme id-type id-namespace id-name id-version id-qualifiers id-subpath) 739 | (remhash "version_overrides" source) 740 | (let ((platforms (gethash "supported_platforms" source))) 741 | (when platforms 742 | (unless (seq-some (lambda (x) (mason--target-match x)) platforms) 743 | (error "Package `%s' only supports platforms `%s'" name (json-serialize platforms))))) 744 | ,p-namespace 745 | ,p-version 746 | ,p-subpath 747 | ,p-qualifiers 748 | ,@body 749 | t))))) 750 | 751 | (defun mason--source-target (source key) 752 | "Get value with matching target from SOURCE[KEY]. 753 | See `mason--target-match'" 754 | (let ((val (gethash key source))) 755 | (unless val (error "Missing `%s'" key)) 756 | (when (vectorp val) 757 | (setq val 758 | (seq-find 759 | (lambda (e) 760 | (let ((target (gethash "target" e))) 761 | (unless (vectorp target) 762 | (setq target (vector target))) 763 | (seq-some (lambda (x) 764 | (when (mason--target-match x) 765 | (mason--info "Target `%s' chosen" x) 766 | t)) 767 | target))) 768 | val)) 769 | (unless val (error "No matching `%s' for target %s" key mason--target)) 770 | (puthash key val source)) 771 | val)) 772 | 773 | (defun mason--source-build (build id prefix next) 774 | "BUILD package in PREFIX, then call NEXT. 775 | Expand BUILD[env] with ID." 776 | (let* ((run (gethash "run" build)) 777 | (_ (unless run (error "Nothing to run"))) 778 | (env (gethash "env" build)) 779 | (script (mason--make-shell (make-temp-file "mason-source-build-") run)) 780 | env-alist) 781 | (when env 782 | (maphash (lambda (key val) 783 | (push (cons key (mason--expand val id)) env-alist)) 784 | env)) 785 | (unless mason-dry-run (make-directory prefix t)) 786 | (mason--process (mason--shell-cmd script) 787 | :env env-alist :cwd prefix 788 | :then (lambda (success) 789 | (mason--delete-file script t) 790 | (funcall next success))))) 791 | 792 | (defun mason--source-noop (_name _prefix _id _source _spec next) 793 | "No-op source resolver, simply calls NEXT." 794 | (funcall next t)) 795 | 796 | (mason--source! cargo (:req "cargo" 797 | :qualifiers ("repository_url" "rev" "locked" "features")) 798 | (let (repo-url rev (locked t) features) 799 | (when id-qualifiers 800 | (setq repo-url (gethash "repository_url" id-qualifiers) 801 | rev (string= (gethash "rev" id-qualifiers "") "true") 802 | locked (not (string= (gethash "locked" id-qualifiers "") "false")) 803 | features (gethash "features" id-qualifiers))) 804 | (mason--process `("cargo" "install" 805 | "--root" ,prefix 806 | ,id-name 807 | ,@(if repo-url 808 | `("--git" ,repo-url 809 | ,(if rev "--rev" "--tag") 810 | ,id-version) 811 | `("--version" ,id-version)) 812 | ,@(when locked '("--locked")) 813 | ,@(when features `("--features" ,features))) 814 | :then next))) 815 | 816 | (mason--source! pypi (:req "python" 817 | :qualifiers ("extra")) 818 | (let (extra) 819 | (when id-qualifiers 820 | (setq extra (gethash "extra" id-qualifiers))) 821 | (mason--process `("python" "-m" "venv" ,prefix) 822 | :then 823 | (mason--process2 `(,(mason--expand-child-file-name "bin/pip" prefix) 824 | "install" 825 | ,(if extra (format "%s[%s]==%s" id-name extra id-version) 826 | (format "%s==%s" id-name id-version)) 827 | ,@(seq-into (gethash "extra_packages" source) 'list)) 828 | :cwd prefix 829 | :then next)))) 830 | 831 | (mason--source! npm (:req "npm" 832 | :namespace optional) 833 | (mason--process `("npm" "install" "-g" 834 | "--prefix" ,prefix 835 | ,(concat 836 | id-namespace (when id-namespace "/") 837 | id-name "@" id-version) 838 | ,@(seq-into (gethash "extra_packages" source) 'list)) 839 | :then next)) 840 | 841 | (mason--source! golang (:req "go" 842 | :namespace must 843 | :subpath optional) 844 | (mason--process `("go" "install" ,(concat id-namespace "/" id-name 845 | (when id-subpath (concat "/" id-subpath)) 846 | "@" id-version)) 847 | :env `(("GOBIN" . ,prefix)) 848 | :then next)) 849 | 850 | (mason--source! nuget (:req "dotnet") 851 | (mason--process `("dotnet" "tool" "install" ,id-name 852 | "--version" ,id-version 853 | "--tool-path" ,prefix) 854 | :then next)) 855 | 856 | (mason--source! luarocks (:req "luarocks" 857 | :qualifiers ("repository_url" "dev")) 858 | (let (server dev) 859 | (when id-qualifiers 860 | (setq server (gethash "repository_url" id-qualifiers) 861 | dev (string= "true" (gethash "dev" id-qualifiers "")))) 862 | (mason--process `("luarocks" "install" 863 | "--tree" ,prefix 864 | ,@(when server `("--server" ,server)) 865 | ,@(when dev '("--dev")) 866 | ,id-name ,id-version) 867 | :then next))) 868 | 869 | (mason--source! gem (:req "gem") 870 | (mason--process `("gem" "install" 871 | "--no-user-install" 872 | "--no-format-executable" 873 | "--install-dir" ,prefix 874 | "--bindir" ,(mason--expand-child-file-name "bin" prefix) 875 | "--no-document" 876 | ,(concat id-name ":" id-version) 877 | ,@(seq-into (gethash "extra_packages" source) 'list)) 878 | :env `(("GEM_HOME" . ,prefix)) 879 | :then next)) 880 | 881 | (mason--source! opam (:req "opam") 882 | (mason--process `("opam" "switch" "create" ,prefix 883 | "--yes" "--assume-depexts" 884 | "--packages" ,(concat id-name "." id-version)) 885 | :then next)) 886 | 887 | (mason--source! openvsx (:namespace must) 888 | (let* ((download (gethash "download" source)) 889 | (_ (unless download (error "Missing `download' key"))) 890 | (_ (mason--expect-hash-key download "file")) 891 | (file (gethash "file" download))) 892 | (unless file (error "Missing file to download")) 893 | (setq file (mason--expand file id)) 894 | (unless (string= "vsix" (file-name-extension file)) 895 | (error "File `%s' not a VSCode extension" file)) 896 | (mason--process 897 | (mason--emacs-cmd 898 | `(mason--download-maybe-extract 899 | ,(concat "https://open-vsx.org/api/" id-namespace "/" id-name "/" id-version "/file/" file) 900 | ,prefix)) 901 | :then next))) 902 | 903 | (mason--source! composer (:req "composer" 904 | :namespace must) 905 | (unless mason-dry-run (make-directory prefix t)) 906 | (mason--process `("composer" "init" 907 | "--stability" "stable" 908 | "--no-interaction" 909 | "--working-dir" ,prefix) 910 | :then 911 | (mason--process2 `("composer" "require" 912 | "--working-dir" ,prefix 913 | "--" ,(concat id-namespace "/" id-name ":" id-version)) 914 | :then next))) 915 | 916 | (defconst mason--github-file-regexp 917 | (concat "^" 918 | "\\([A-Za-z0-9_.-]+\\)" ; 1. file path 919 | "\\(" ; 2. optional 920 | ":" 921 | "\\([A-Za-z0-9_./-]+\\)" ; 3. extract path 922 | "\\)?" 923 | "$")) 924 | 925 | (mason--source! github (:req "git" 926 | :namespace must) 927 | (let ((has-asset (gethash "asset" source)) 928 | (has-build (gethash "build" source))) 929 | (cond 930 | ((and has-asset has-build) 931 | (error "Source `%s' has both `asset' and `build' recipe" id-raw)) 932 | (has-asset 933 | (let* ((asset (mason--source-target source "asset")) 934 | (files (gethash "file" asset)) 935 | tasks) 936 | (unless files (error "No files")) 937 | (unless (vectorp files) (setq files (vector files))) 938 | (setq tasks 939 | (mapcar 940 | (lambda (file) 941 | (setq file (mason--expand file id)) 942 | (unless (string-match mason--github-file-regexp file) 943 | (error "Unsupported file asset `%s'" file)) 944 | (let* ((file-path (match-string 1 file)) 945 | (file-url (concat "https://github.com/" id-namespace "/" id-name "/releases/download/" id-version "/" file-path)) 946 | (extract-path (match-string 3 file)) 947 | (extract-dest (if extract-path (mason--expand-child-file-name extract-path prefix) prefix))) 948 | `(mason--download-maybe-extract ,file-url ,extract-dest))) 949 | files)) 950 | (mason--process 951 | (apply #'mason--emacs-cmd tasks) 952 | :then next))) 953 | (has-build 954 | (let ((build (mason--source-target source "build"))) 955 | (mason--process `("git" "clone" "--depth" "1" "--quiet" 956 | ,(concat "https://github.com/" id-namespace "/" id-name ".git") 957 | ,prefix) 958 | :then 959 | (mason--process2 `("git" "fetch" "--depth" "1" "--quiet" "origin" ,id-version) 960 | :cwd prefix 961 | :then 962 | (mason--process2 `("git" "checkout" "--quiet" "FETCH_HEAD") 963 | :cwd prefix 964 | :then (lambda (success) 965 | (if success (mason--source-build build id prefix next) 966 | (funcall next nil)))))))) 967 | (t (error "Source `%s' has no `asset' nor `build'" id-raw))))) 968 | 969 | (mason--source! generic (:namespace optional) 970 | (let ((has-download (gethash "download" source)) 971 | (has-build (gethash "build" source))) 972 | (cond 973 | ((and has-download has-build) 974 | (error "Source `%s' has both `asset' and `build' recipe" id-raw)) 975 | (has-download 976 | (let* ((download (mason--source-target source "download")) 977 | (files (gethash "files" download)) 978 | tasks) 979 | (unless files (error "No files")) 980 | (maphash (lambda (dest url) 981 | (setq url (mason--expand url id)) 982 | (let ((archive (mason--archive-name dest))) 983 | (when archive 984 | (setq dest archive) 985 | (when (string= dest name) 986 | (setq dest ".")))) 987 | (setq dest (mason--expand-child-file-name dest prefix)) 988 | (push `(mason--download-maybe-extract ,url ,dest) tasks)) 989 | files) 990 | (mason--process 991 | (apply #'mason--emacs-cmd (nreverse tasks)) 992 | :then next))) 993 | (has-build 994 | (let ((build (mason--source-target source "build"))) 995 | (mason--source-build build id prefix next))) 996 | (t (error "Source `%s' has no `download' nor `build'" id-raw))))) 997 | 998 | 999 | ;; Binary Resolvers 1000 | 1001 | (defconst mason--bin-requirements nil) 1002 | 1003 | (defmacro mason--bin! (type req &rest body) 1004 | "Define a mason binary resolver for TYPE. 1005 | REQ is external program requirements. 1006 | BODY is `progn' body. 1007 | 1008 | Inside BODY, one can reference: 1009 | - PREFIX is where the package should've been installed. 1010 | - PATH is where the wrapper/link should be placed. 1011 | - TARGET is the target binary, depends on the TYPE. 1012 | - UNINSTALL is whether to install or uninstall the binary." 1013 | (declare (indent defun)) 1014 | `(progn 1015 | (push (cons ',type ',req) mason--bin-requirements) 1016 | (defun ,(intern (concat "mason--bin-" (symbol-name type))) (prefix path target uninstall) 1017 | (ignore prefix path target) 1018 | ,@body))) 1019 | 1020 | (defmacro mason--bin-link! (path target) 1021 | "Call `mason--link' with PATH and TARGET." 1022 | `(if uninstall (mason--delete-file ,path) 1023 | (mason--link ,path ,target t) 1024 | (unless mason-dry-run 1025 | (set-file-modes path (file-modes-symbolic-to-number "+x" (file-modes path)))))) 1026 | 1027 | (defmacro mason--bin-executable! (name dir &optional win-ext) 1028 | "Binary resolver NAME that links to binary path inside DIR. 1029 | WIN-EXT is the extension to add when on windows." 1030 | `(mason--bin! ,name nil 1031 | ,@(when win-ext 1032 | `((when (mason--is-windows t) 1033 | (setq path (concat path ,win-ext) 1034 | target (concat target ,win-ext))))) 1035 | (if uninstall (mason--delete-file path) 1036 | (mason--link path (mason--expand-child-file-name (concat ,dir "/" target) prefix) t)))) 1037 | 1038 | (cl-defmacro mason--bin-wrapper! (content &optional &key env) 1039 | "Call `mason--make-shell' with CONTENT and ENV." 1040 | `(if uninstall (mason--delete-file path) 1041 | (mason--make-shell path ,content :overwrite t :env ,env))) 1042 | 1043 | (defmacro mason--bin-exec! (name &rest cmd) 1044 | "Binary resolver NAME that creates wrapper for DIR/CMD with ENV." 1045 | (unless (listp cmd) (setq cmd (list cmd))) 1046 | `(mason--bin! ,name ,(nth 0 cmd) 1047 | (mason--bin-wrapper! (list (mason--shell-exec) ,@cmd (mason--expand-child-file-name target prefix) (mason--shell-args))))) 1048 | 1049 | (mason--bin! path nil (mason--bin-link! path (mason--expand-child-file-name target prefix))) 1050 | 1051 | (mason--bin-exec! exec) 1052 | (mason--bin-exec! dotnet "dotnet") 1053 | (mason--bin-exec! java-jar "java" "-jar") 1054 | (mason--bin-exec! node "node") 1055 | (mason--bin-exec! php "php") 1056 | (mason--bin-exec! python "python3") 1057 | (mason--bin-exec! ruby "ruby") 1058 | 1059 | (mason--bin-executable! npm "bin" ".cmd") 1060 | (mason--bin-executable! cargo "bin" ".exe") 1061 | (mason--bin-executable! golang "." ".exe") 1062 | (mason--bin-executable! nuget "." ".exe") 1063 | (mason--bin-executable! luarocks "bin" ".bat") 1064 | (mason--bin-executable! opam "_opam/bin" ".exe") 1065 | (mason--bin-executable! composer "vendor/bin" ".bat") 1066 | 1067 | (mason--bin! pypi nil 1068 | (let (extension (bin-dir "bin/")) 1069 | (when (mason--is-windows 'cygwin) (setq extension ".exe")) 1070 | (when (mason--is-windows) (setq bin-dir "Scripts/")) 1071 | (mason--bin-link! (concat path extension) 1072 | (mason--expand-child-file-name (concat bin-dir target extension) prefix)))) 1073 | 1074 | (mason--bin! pyvenv nil 1075 | (let ((python "bin/python")) 1076 | (when (mason--is-cygwin) (setq python "bin/python.exe")) 1077 | (when (mason--is-windows) (setq python "Scripts/python.exe")) 1078 | (mason--bin-wrapper! `(,(mason--shell-exec) 1079 | ,(mason--expand-child-file-name python prefix) 1080 | "-m" ,target 1081 | ,(mason--shell-args))))) 1082 | 1083 | (mason--bin! gem nil 1084 | (when (mason--is-windows t) 1085 | (setq target (concat target ".bat"))) 1086 | (mason--bin-wrapper! `(,(mason--shell-exec) 1087 | ,(mason--expand-child-file-name (concat "bin/" target) prefix) 1088 | ,(mason--shell-args)) 1089 | :env `(("GEM_PATH" . ,(concat prefix path-separator (mason--shell-env "GEM_PATH")))))) 1090 | 1091 | 1092 | ;; Doctor 1093 | 1094 | (define-derived-mode mason-doctor-mode special-mode "Mason Doctor" :interactive nil) 1095 | 1096 | ;;;###autoload 1097 | (defun mason-doctor () 1098 | "Validate external program requirements." 1099 | (interactive) 1100 | (with-current-buffer (get-buffer-create "*mason-doctor*") 1101 | (read-only-mode -1) 1102 | (erase-buffer) 1103 | (insert "List of external program that might be needed.\n" 1104 | "Note that there might be additional program needed for a generic package.") 1105 | (insert "\n\nSource Resolvers: \n") 1106 | (mason--doctor mason--source-requirements) 1107 | (insert "\nBinary Resolvers: \n") 1108 | (mason--doctor mason--bin-requirements) 1109 | (insert "\nExtractors: \n") 1110 | (mason--doctor mason--extract-requirements) 1111 | (read-only-mode 1) 1112 | (mason-doctor-mode) 1113 | (pop-to-buffer (current-buffer)))) 1114 | 1115 | (defun mason--doctor (alist) 1116 | "Validate requirements for TYPE and ALIST." 1117 | (dolist (e alist) 1118 | (let ((symbol (car e)) 1119 | (progs (cdr e))) 1120 | (unless (listp progs) 1121 | (setq progs (list progs))) 1122 | (when progs 1123 | (insert "- " (symbol-name symbol) ": ") 1124 | (dolist (prog progs) 1125 | (insert (propertize (concat prog " ") 'face (if (executable-find prog) 'success 'error)))) 1126 | (insert ?\n))))) 1127 | 1128 | 1129 | ;; The Installer 1130 | 1131 | (defvar mason--registry 'nan) 1132 | (defvar mason--installed 'nan) 1133 | (defvar mason--updatable 'nan) 1134 | (defvar mason--pending (mason--make-hash)) 1135 | 1136 | (defun mason--assert-ensured () 1137 | "Assert if `mason--registry' is available." 1138 | (when (or (eq mason--registry 'nan) 1139 | (eq mason--installed 'nan) 1140 | (eq mason--updatable 'nan)) 1141 | (error "Call `mason-ensure' on your init.el")) 1142 | (when (or (eq mason--registry 'on-process) 1143 | (eq mason--installed 'on-process) 1144 | (eq mason--updatable 'on-process)) 1145 | (error "Mason is not ready yet"))) 1146 | 1147 | (defvar mason--package-list nil) 1148 | (defun mason--get-package-list () 1149 | "Get list of mason packages." 1150 | (mason--assert-ensured) 1151 | (or mason--package-list 1152 | (setq mason--package-list (mason--hash-keys mason--registry)))) 1153 | 1154 | (defvar mason--category-list nil) 1155 | (defun mason--get-category-list () 1156 | "Get list of mason categories." 1157 | (mason--assert-ensured) 1158 | (or 1159 | mason--category-list 1160 | (setq 1161 | mason--category-list 1162 | (let ((table (mason--make-hash "All" t "Other" t))) 1163 | (maphash (lambda (_k v) 1164 | (when-let* ((cat (gethash "categories" v))) 1165 | (mapc (lambda (c) 1166 | (puthash c t table)) 1167 | cat))) 1168 | mason--registry) 1169 | (mason--hash-keys table))))) 1170 | 1171 | (defvar mason--language-list nil) 1172 | (defun mason--get-language-list () 1173 | "Get list of mason languages." 1174 | (mason--assert-ensured) 1175 | (or 1176 | mason--language-list 1177 | (setq 1178 | mason--language-list 1179 | (let ((table (mason--make-hash "All" t "None" t))) 1180 | (maphash (lambda (_k v) 1181 | (when-let* ((cat (gethash "languages" v))) 1182 | (mapc (lambda (c) 1183 | (puthash c t table)) 1184 | cat))) 1185 | mason--registry) 1186 | (mason--hash-keys table))))) 1187 | 1188 | (defun mason--update-installed () 1189 | "Update `mason--installed'." 1190 | (let ((installed-index (mason--expand-child-file-name "packages/index" mason-dir))) 1191 | (setq mason--installed (or (mason--read-data installed-index) 1192 | (mason--make-hash))))) 1193 | 1194 | (defun mason--update-updatable1 (spec) 1195 | "Add SPEC to `mason--updatable' if it is updatable." 1196 | (let* ((i-name (gethash "name" spec)) 1197 | (i-source (gethash "source" spec)) 1198 | (i-id (gethash "id" i-source)) 1199 | (i-purl (mason--parse-purl i-id)) 1200 | (i-version (gethash "version" i-purl)) 1201 | (u-spec (gethash i-name mason--registry)) 1202 | (u-source (gethash "source" u-spec)) 1203 | (u-id (gethash "id" u-source)) 1204 | (case-fold-search t)) 1205 | (when (or (not (string= i-id u-id)) 1206 | (seq-some (lambda (r) (string-match-p r i-version)) mason-moving-versions)) 1207 | (puthash i-name spec mason--updatable)))) 1208 | 1209 | (defun mason--update-updatable () 1210 | "Update `mason--updatable'." 1211 | (setq mason--updatable (mason--make-hash)) 1212 | (maphash (lambda (_ spec) (mason--update-updatable1 spec)) 1213 | mason--installed)) 1214 | 1215 | ;;;###autoload 1216 | (defun mason-update-registry (&optional callback) 1217 | "Refresh the mason registry then call CALLBACK." 1218 | (interactive) 1219 | (setq mason--registry 'on-process 1220 | mason--updatable 'on-process 1221 | mason--package-list nil 1222 | mason--category-list nil 1223 | mason--language-list nil) 1224 | (mason--update-target 1225 | (lambda () 1226 | (mason--update-installed) 1227 | (let* ((reg-dir (mason--expand-child-file-name "registry" mason-dir)) 1228 | (reg-index (mason--expand-child-file-name "index" reg-dir))) 1229 | (mason--process 1230 | (mason--emacs-cmd 1231 | `(let ((reg (mason--make-hash)) 1232 | (regs ',mason-registries) 1233 | (reg-dir ,reg-dir) 1234 | (reg-index ,reg-index)) 1235 | (when (file-directory-p reg-dir) 1236 | (mason--delete-directory reg-dir t)) 1237 | (dolist (e regs) 1238 | (let* ((name (car e)) 1239 | (url (cdr e)) 1240 | (dest (mason--expand-child-file-name name reg-dir))) 1241 | (make-directory dest t) 1242 | (mason--download-maybe-extract url dest) 1243 | (dolist (file (directory-files dest 'full "\\.json\\'")) 1244 | (mason--info "Reading registry %s" file) 1245 | (with-temp-buffer 1246 | (insert-file-contents file) 1247 | (goto-char (point-min)) 1248 | (mapc (lambda (e) 1249 | (puthash "registry" name e) 1250 | (puthash (gethash "name" e) e reg)) 1251 | (json-parse-buffer)))))) 1252 | (with-temp-file reg-index 1253 | (prin1 reg (current-buffer))))) 1254 | :then 1255 | (lambda (success) 1256 | (if (not success) (error "Error downloading registry") 1257 | (setq mason--registry (or (mason--read-data reg-index) 1258 | (mason--make-hash))) 1259 | (mason--update-updatable) 1260 | (mason--success "Mason registry updated") 1261 | (when (functionp callback) 1262 | (funcall callback))))))))) 1263 | 1264 | ;;;###autoload 1265 | (defun mason-ensure (&optional callback) 1266 | "Ensure mason is setup. 1267 | Call CALLBACK if it succeeded." 1268 | (let* ((bin-dir (mason--expand-child-file-name "bin" mason-dir)) 1269 | (reg-index (mason--expand-child-file-name "registry/index" mason-dir)) 1270 | (reg-time (file-attribute-modification-time (file-attributes reg-index))) 1271 | reg-age) 1272 | (setenv "PATH" (concat bin-dir ":" (getenv "PATH"))) 1273 | (add-to-list 'exec-path bin-dir) 1274 | (if (null reg-time) 1275 | (mason-update-registry callback) 1276 | (setq reg-age (float-time (time-subtract (current-time) reg-time))) 1277 | (if (and (> mason-registry-refresh-time 0) (> reg-age mason-registry-refresh-time)) 1278 | (mason-update-registry callback) 1279 | (mason--update-target 1280 | (lambda () 1281 | (mason--update-installed) 1282 | (setq mason--registry (mason--read-data reg-index)) 1283 | (mason--update-updatable) 1284 | (mason--info "Mason ready") 1285 | (when (functionp callback) 1286 | (funcall callback)))))))) 1287 | 1288 | (defvar mason--ask-package-prompt nil) 1289 | (defvar mason--ask-package-callback nil) 1290 | (defvar mason--ask-package-category nil) 1291 | (defvar mason--ask-package-language nil) 1292 | (defvar mason--ask-package-filter nil) 1293 | (defvar mason--ask-package-filter-function nil) 1294 | (defvar mason--ask-package-input nil) 1295 | 1296 | (mason--keymap! mason-filter-map) 1297 | (fset 'mason-filter-map mason-filter-map) 1298 | 1299 | (mason--keymap! mason--ask-package-transient-map 1300 | "M-m" mason-filter-map) 1301 | 1302 | (defmacro mason--filter! (key name &rest body) 1303 | "Create a filter function NAME for BODY, assign it to KEY." 1304 | (declare (indent 2)) 1305 | `(progn 1306 | (defun ,name (fake) 1307 | (interactive (list t) nil) 1308 | (setq mason--ask-package-filter-function nil) 1309 | (unless (and mason--ask-package-prompt 1310 | mason--ask-package-callback) 1311 | (user-error "Must not be called manually")) 1312 | (when fake 1313 | (setq mason--ask-package-filter-function ',name) 1314 | (exit-minibuffer)) 1315 | ,@body 1316 | (mason--ask-package-0)) 1317 | (define-key mason-filter-map ,key #',name))) 1318 | 1319 | (mason--filter! "c" mason-filter-category 1320 | (let* ((completion-extra-properties nil) 1321 | (cat (completing-read "Category: " (mason--get-category-list) nil t nil nil "All"))) 1322 | (unless (string-empty-p cat) 1323 | (setq mason--ask-package-category (if (string= cat "All") nil cat))))) 1324 | 1325 | (mason--filter! "d" mason-toggle-deprecated 1326 | (setq mason-show-deprecated (not mason-show-deprecated))) 1327 | 1328 | (mason--filter! "l" mason-filter-language 1329 | (let* ((completion-extra-properties nil) 1330 | (lang (completing-read "Language: " (mason--get-language-list) nil t nil nil "All"))) 1331 | (unless (string-empty-p lang) 1332 | (setq mason--ask-package-language (if (string= lang "All") nil lang))))) 1333 | 1334 | (defun mason--ask-package-affixation-function (pkgs) 1335 | "Affixation function for PKGS to be used with `completion-extra-properties'." 1336 | (when pkgs 1337 | (let* ((lens (mapcar (lambda (p) (length p)) pkgs)) 1338 | (margin (max (+ (apply #'max lens) 4) 20))) 1339 | (mapcar 1340 | (lambda (name) 1341 | (let* ((len (length name)) 1342 | (spaces (make-string (- margin len) ?\s)) 1343 | (pkg (gethash name mason--registry)) 1344 | (desc (gethash "description" pkg)) 1345 | (desc (replace-regexp-in-string "\n" " " desc)) 1346 | (deprecated (gethash "deprecation" pkg))) 1347 | (list name 1348 | nil 1349 | (concat 1350 | spaces 1351 | (when deprecated (propertize "[Deprecated] " 'face 'error)) 1352 | (propertize desc 'face 'font-lock-doc-face))))) 1353 | pkgs)))) 1354 | 1355 | (defun mason--ask-package (prompt filter callback) 1356 | "Ask for package with PROMPT and FILTER. 1357 | Call CALLBACK with the selected package spec." 1358 | (unless (and prompt callback) 1359 | (user-error "Called without prompt and callback")) 1360 | (setq mason--ask-package-prompt prompt 1361 | mason--ask-package-callback callback 1362 | mason--ask-package-filter filter) 1363 | (unwind-protect (mason--ask-package-0) 1364 | (setq mason--ask-package-prompt nil 1365 | mason--ask-package-callback nil 1366 | mason--ask-package-category nil 1367 | mason--ask-package-language nil 1368 | mason--ask-package-filter-function nil 1369 | mason--ask-package-input nil))) 1370 | 1371 | (defun mason--ask-package-0 () 1372 | "Implementation for `mason--ask-package'." 1373 | (set-transient-map mason--ask-package-transient-map (lambda () (minibufferp))) 1374 | (let* ((cat mason--ask-package-category) 1375 | (lang mason--ask-package-language) 1376 | (filter-key (where-is-internal 'mason-filter-map mason--ask-package-transient-map 'firstonly)) 1377 | (completion-extra-properties '(:affixation-function mason--ask-package-affixation-function)) 1378 | (pkg 1379 | (minibuffer-with-setup-hook 1380 | (lambda () (when filter-key (mason--echo (substitute-command-keys (format "\\`%s' to open menu" (key-description filter-key)))))) 1381 | (completing-read 1382 | (concat 1383 | mason--ask-package-prompt 1384 | (cond ((and cat lang) (format " (C:%s, L:%s)" cat lang)) 1385 | (cat (format " (C:%s)" cat)) 1386 | (lang (format " (L:%s)" lang)) 1387 | (t nil)) 1388 | ": ") 1389 | (seq-filter 1390 | (lambda (p) 1391 | (let* ((pkg (gethash p mason--registry)) 1392 | (cats (gethash "categories" pkg [])) 1393 | (langs (gethash "languages" pkg [])) 1394 | (deprecation (gethash "deprecation" pkg))) 1395 | (when (seq-empty-p cats) (setq cats ["Other"])) 1396 | (when (seq-empty-p langs) (setq langs ["None"])) 1397 | (and (funcall mason--ask-package-filter p) 1398 | (or mason-show-deprecated 1399 | (null deprecation)) 1400 | (or (null cat) 1401 | (seq-contains-p cats cat)) 1402 | (or (null lang) 1403 | (seq-contains-p langs lang))))) 1404 | (mason--get-package-list)) 1405 | nil t mason--ask-package-input)))) 1406 | (if (or (string-empty-p pkg) mason--ask-package-filter-function) 1407 | (progn 1408 | (setq mason--ask-package-input pkg) 1409 | (funcall mason--ask-package-filter-function nil)) 1410 | (funcall mason--ask-package-callback (gethash pkg mason--registry))))) 1411 | 1412 | (defmacro mason--with-installed (&rest body) 1413 | "Run BODY with `mason--installed' as the registry." 1414 | (declare (indent defun)) 1415 | `(if (= (hash-table-count mason--installed) 0) 1416 | (mason--info "No package has been installed") 1417 | (let ((mason--registry mason--installed) 1418 | (mason-show-deprecated t) 1419 | mason--package-list mason--category-list mason--language-list) 1420 | ,@body))) 1421 | 1422 | ;;;###autoload 1423 | (defun mason-installed-p (package) 1424 | "Checks if PACKAGE is already installed." 1425 | (mason--assert-ensured) 1426 | (when (gethash package mason--installed) t)) 1427 | 1428 | ;;;###autoload 1429 | (defun mason-install (package &optional force interactive callback) 1430 | "Install a Mason PACKAGE. 1431 | If FORCE non nil delete existing installation, if exists. 1432 | If INTERACTIVE, ask for PACKAGE and FORCE. 1433 | 1434 | CALLBACK is a function that will be called with one argument, 1435 | indicating the package success to install." 1436 | (interactive '(nil nil t nil)) 1437 | (if (or package (not interactive)) 1438 | (mason--install-0 (gethash package mason--registry) force interactive nil callback) 1439 | (mason--ask-package "Mason Install" 1440 | (lambda (p) (and (null (gethash p mason--installed)) 1441 | (null (gethash p mason--pending)))) 1442 | (lambda (p) (mason--install-0 p nil t nil callback))))) 1443 | 1444 | ;;;###autoload 1445 | (defun mason-uninstall (package &optional interactive callback) 1446 | "Uninstall a Mason PACKAGE. 1447 | If INTERACTIVE, ask for PACKAGE. 1448 | 1449 | CALLBACK is a function that will be called with one argument, 1450 | indicating the package success to uninstall." 1451 | (interactive '(nil t nil)) 1452 | (if (or package (not interactive)) 1453 | (mason--install-0 (gethash package mason--installed) nil interactive t callback) 1454 | (mason--with-installed 1455 | (mason--ask-package "Mason Uninstall" 1456 | #'identity 1457 | (lambda (p) (mason--install-0 p nil t t callback)))))) 1458 | 1459 | ;;;###autoload 1460 | (defun mason-update (package &optional interactive callback) 1461 | "Update a Mason PACKAGE. 1462 | If INTERACTIVE, ask for PACKAGE. 1463 | 1464 | CALLBACK is a function that will be called with one argument, 1465 | indicating the package success to update." 1466 | (interactive '(nil t nil)) 1467 | (let ((install (lambda (pkg) 1468 | (lambda (success) 1469 | (if success (mason-install pkg interactive callback) 1470 | (funcall callback nil)))))) 1471 | (cond 1472 | ((= 0 (hash-table-count mason--updatable)) 1473 | (mason--info "No update available")) 1474 | ((or package (not interactive)) 1475 | (mason-uninstall package interactive (funcall install package))) 1476 | (t (mason--with-installed 1477 | (setq mason--registry mason--updatable) 1478 | (mason--ask-package "Mason Update" 1479 | #'identity 1480 | (lambda (p) 1481 | (setq p (gethash "name" p)) 1482 | (mason-uninstall p nil (funcall install p))))))))) 1483 | 1484 | (defun mason--install-0 (spec force interactive uninstall callback) 1485 | "Implementation of `mason-install' and `mason-uninstall'. 1486 | Args: SPEC FORCE INTERACTIVE UNINSTALL CALLBACK." 1487 | (let* ((spec (read (prin1-to-string spec))) ; deep copy 1488 | (name (gethash "name" spec)) 1489 | (deprecation (gethash "deprecation" spec)) 1490 | (packages-dir (mason--expand-child-file-name "packages" mason-dir)) 1491 | (package-dir (file-name-as-directory (mason--expand-child-file-name name packages-dir))) 1492 | ;; source 1493 | (source (gethash "source" spec)) 1494 | (source-id-raw (gethash "id" source)) 1495 | (source-id (mason--parse-purl source-id-raw)) 1496 | (source-type (if uninstall "noop" (gethash "type" source-id))) 1497 | (source-fn (intern (concat "mason--source-" source-type))) 1498 | ;; links 1499 | (spec-id-ctx (mason--merge-hash spec source-id)) 1500 | (bin (gethash "bin" spec)) 1501 | (share (gethash "share" spec)) 1502 | (opt (gethash "opt" spec)) 1503 | (mason--log-pkg name) 1504 | callback2) 1505 | (mason--wrap-error (lambda (_) (error "")) nil 1506 | (when (gethash name mason--pending) 1507 | (error "Package `%s' is still pending" name)) 1508 | (mason--expect-hash-key spec 1509 | "name" "description" "homepage" "deprecation" 1510 | "licenses" "languages" "categories" 1511 | "source" "bin" "share" "opt" "schemas" 1512 | "registry" "neovim" "ci_skip") 1513 | (when (and deprecation interactive (not uninstall)) 1514 | (unless (y-or-n-p (format-message 1515 | "Package `%s' is deprecated since `%s' with the message:\n\t%s\nInstall anyway? " 1516 | name (gethash "since" deprecation) (gethash "message" deprecation))) 1517 | (error "Cancelled"))) 1518 | (if uninstall (mason--info "Uninstalling package `%s'" name) 1519 | (mason--info "Installing package `%s' from source `%s'" name (url-unhex-string source-id-raw))) 1520 | (when (not (fboundp source-fn)) 1521 | (error "Unsupported source type `%s' in id `%s'" source-type source-id-raw)) 1522 | (when (and (not uninstall) 1523 | (not mason-dry-run) 1524 | (file-directory-p package-dir) 1525 | (not (directory-empty-p package-dir))) 1526 | (if (not interactive) 1527 | (if force (mason--delete-directory package-dir t) 1528 | (error "Directory %s already exists" package-dir)) 1529 | (if (y-or-n-p (format-message "Directory %s exists, delete? " package-dir)) 1530 | (mason--delete-directory package-dir t) 1531 | (error "Cancelled"))))) 1532 | (puthash name t mason--pending) 1533 | (when (fboundp 'mason-manager--update) 1534 | (mason-manager--update name)) 1535 | (setq callback2 1536 | (lambda (success) 1537 | (remhash name mason--pending) 1538 | (if success (mason--success "%s `%s'" (if uninstall "Uninstalled" "Installed") name) 1539 | (mason--error "%s of `%s' failed" (if uninstall "Uninstallation" "Installation") name)) 1540 | (when success 1541 | (unless mason-dry-run 1542 | (cond 1543 | (uninstall 1544 | (remhash name mason--installed) 1545 | (remhash name mason--updatable)) 1546 | (t 1547 | (puthash name spec mason--installed) 1548 | (mason--update-updatable1 spec))) 1549 | (with-temp-file (mason--expand-child-file-name "index" packages-dir) 1550 | (prin1 mason--installed (current-buffer))))) 1551 | (when (fboundp 'mason-manager--update) 1552 | (mason-manager--update name (not success))) 1553 | (when (functionp callback) (funcall callback success)))) 1554 | (mason--wrap-error callback2 nil 1555 | (funcall 1556 | source-fn name package-dir source-id source spec 1557 | (lambda (success) 1558 | (if (not success) 1559 | (funcall callback2 nil) 1560 | (mason--wrap-error callback2 nil 1561 | (when bin 1562 | (maphash 1563 | (lambda (key val-raw) 1564 | (setq val-raw (mason--expand (mason--expand val-raw spec-id-ctx) source-id)) 1565 | (unless (string-empty-p val-raw) 1566 | (let* ((val (mason--parse-bin val-raw)) 1567 | (bin-type (gethash "type" val)) 1568 | (bin-path (gethash "path" val)) 1569 | (bin-fn (intern (concat "mason--bin-" bin-type)))) 1570 | (when (or (null val) (not (fboundp bin-fn))) 1571 | (error "Unsupported binary `%s'" val-raw)) 1572 | (let* ((bin-dir (mason--expand-child-file-name "bin" mason-dir)) 1573 | (bin-link (mason--expand-child-file-name key bin-dir))) 1574 | (mason--info "Resolving binary `%s'" val-raw) 1575 | (funcall bin-fn package-dir bin-link bin-path uninstall))))) 1576 | bin)) 1577 | (when share (mason--link-share-opt "share" share spec-id-ctx source-id package-dir uninstall)) 1578 | (when opt (mason--link-share-opt "opt" opt spec-id-ctx source-id package-dir uninstall)) 1579 | (if (not uninstall) (funcall callback2 t) 1580 | (mason--process 1581 | (mason--emacs-cmd `(mason--delete-directory ,package-dir t)) 1582 | :then callback2))))))))) 1583 | 1584 | (defun mason--link-share-opt (dest-dir table spec-id-ctx source-id package-dir uninstall) 1585 | "Link share or opt DEST-DIR from hash TABLE relative to PACKAGE-DIR. 1586 | Expand TABLE from SPEC-ID-CTX and SOURCE-ID, if necessary." 1587 | (mason--info "Symlinking %s" dest-dir) 1588 | (setq dest-dir (mason--expand-child-file-name dest-dir mason-dir)) 1589 | (maphash 1590 | (lambda (link-dest link-source) 1591 | (setq link-source (mason--expand (mason--expand link-source spec-id-ctx) source-id)) 1592 | (unless (string-empty-p link-source) 1593 | (setq link-source (mason--expand-child-file-name link-source package-dir) 1594 | link-dest (expand-file-name link-dest dest-dir)) 1595 | (cond 1596 | ;; link/dest/: link/source/ 1597 | ((directory-name-p link-dest) 1598 | (unless (directory-name-p link-source) 1599 | (error "Link source `%s' is not a directory" link-source)) 1600 | (unless mason-dry-run 1601 | (unless (file-directory-p link-source) 1602 | (error "Link source `%s' does not exist" link-source)) 1603 | (make-directory link-dest t) 1604 | (dolist (entry (directory-files link-source nil directory-files-no-dot-files-regexp)) 1605 | (let ((entry-dest (mason--expand-child-file-name entry link-dest)) 1606 | (entry-source (mason--expand-child-file-name entry link-source))) 1607 | (if uninstall (mason--delete-file entry-dest) 1608 | (mason--link entry-dest entry-source t)))) 1609 | (when (and uninstall (directory-empty-p link-dest)) 1610 | (mason--delete-directory link-dest)))) 1611 | ;; link/dest: link/source 1612 | (t 1613 | (when (directory-name-p link-source) 1614 | (error "Link source `%s' is a directory" link-source)) 1615 | (unless mason-dry-run 1616 | (unless (file-exists-p link-source) 1617 | (error "Link source `%s' does not exist" link-source)) 1618 | (make-directory (file-name-parent-directory link-dest) t) 1619 | (if uninstall (mason--delete-file link-dest) 1620 | (mason--link link-dest link-source t))))))) 1621 | table)) 1622 | 1623 | (defun mason-dry-run-install (package) 1624 | "Dry run install a PACKAGE." 1625 | (let ((prev-dry-run mason-dry-run) 1626 | (prev-mason-dir mason-dir)) 1627 | (setq mason-dry-run t 1628 | mason-dir (make-temp-file "mason-dry-run-" 'dir)) 1629 | (mason-install 1630 | package nil nil 1631 | (lambda (_) 1632 | (delete-directory mason-dir) 1633 | (setq mason-dry-run prev-dry-run 1634 | mason-dir prev-mason-dir) 1635 | (mason-ensure))))) 1636 | 1637 | (defun mason-dry-run-install-all (&optional callback) 1638 | "Dry run install all packages. 1639 | Call CALLBACK with success and total packages." 1640 | (let* ((prev-dry-run mason-dry-run) 1641 | (prev-mason-dir mason-dir) 1642 | (packages (mason--get-package-list)) 1643 | (total-count (length packages)) 1644 | (success-count 0) 1645 | (current-idx -1) 1646 | failed 1647 | installer) 1648 | (setq mason-dry-run t 1649 | mason-dir (make-temp-file "mason-dry-run-" 'dir)) 1650 | (with-current-buffer (mason-buffer) 1651 | (read-only-mode -1) 1652 | (erase-buffer) 1653 | (read-only-mode 1)) 1654 | (mason--info "Started dry run test in `%s'" mason-dir) 1655 | (setq 1656 | installer 1657 | (lambda (success) 1658 | (if success 1659 | (setq success-count (1+ success-count)) 1660 | (when (> current-idx 0) (push (nth current-idx packages) failed))) 1661 | (setq current-idx (1+ current-idx)) 1662 | (if (< current-idx total-count) 1663 | (mason-install (nth current-idx packages) 1664 | nil nil 1665 | (lambda (s) 1666 | (run-at-time 1667 | 0 nil (lambda () 1668 | (funcall installer s))))) 1669 | (mason--info "Installed %d/%d packages, failed packages\n%s%S" 1670 | success-count total-count 1671 | (s-repeat 8 " ") (nreverse failed)) 1672 | (delete-directory mason-dir) 1673 | (setq mason-dry-run prev-dry-run 1674 | mason-dir prev-mason-dir) 1675 | (mason-ensure) 1676 | (when (functionp callback) 1677 | (funcall callback success-count total-count))))) 1678 | (funcall installer nil) 1679 | t)) 1680 | 1681 | (provide 'mason) 1682 | ;;; mason.el ends here 1683 | --------------------------------------------------------------------------------