├── .ert-runner ├── helpers ├── .nosearch ├── tester.el ├── run.sh ├── paradox-counter.el └── dash.el ├── after.png ├── before.png ├── multi-line.png ├── .gitignore ├── Cask ├── .circleci └── config.yml ├── Dockerfile ├── test ├── test-helper.el └── paradox-test.el ├── .github └── main.workflow ├── Makefile ├── .travis.yml ├── paradox-core.el ├── README.md ├── paradox-commit-list.el ├── paradox.el ├── paradox-execute.el ├── paradox-github.el ├── LICENSE └── paradox-menu.el /.ert-runner: -------------------------------------------------------------------------------- 1 | -L . 2 | -------------------------------------------------------------------------------- /helpers/.nosearch: -------------------------------------------------------------------------------- 1 | 2 | -------------------------------------------------------------------------------- /after.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Malabarba/paradox/HEAD/after.png -------------------------------------------------------------------------------- /before.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Malabarba/paradox/HEAD/before.png -------------------------------------------------------------------------------- /multi-line.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Malabarba/paradox/HEAD/multi-line.png -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | flycheck_* 2 | /paradox-autoloads.el 3 | /paradox-pkg.el 4 | /.cask/ 5 | /.dir-locals?.el 6 | -------------------------------------------------------------------------------- /Cask: -------------------------------------------------------------------------------- 1 | (source gnu) 2 | (source melpa-stable) 3 | 4 | (package-file "paradox.el") 5 | (files "paradox*.el") 6 | 7 | (development 8 | (depends-on "ert-runner") 9 | (depends-on "undercover")) 10 | -------------------------------------------------------------------------------- /helpers/tester.el: -------------------------------------------------------------------------------- 1 | (progn 2 | (add-to-list 'load-path (expand-file-name "../")) 3 | (add-to-list 'load-path (expand-file-name "./")) 4 | (setq package-user-dir "~/oi") 5 | (require 'paradox) 6 | (call-interactively 'paradox-list-packages)) 7 | -------------------------------------------------------------------------------- /.circleci/config.yml: -------------------------------------------------------------------------------- 1 | version: 2 2 | jobs: 3 | build: 4 | docker: 5 | - image: silex/emacs:26.2-dev 6 | 7 | steps: 8 | - checkout 9 | 10 | - run: 11 | name: Install Deps 12 | command: cask install || cask install 13 | 14 | - run: 15 | name: Run tests 16 | command: cask exec ert-runner 17 | -------------------------------------------------------------------------------- /Dockerfile: -------------------------------------------------------------------------------- 1 | FROM silex/emacs:26.2-alpine-dev 2 | # ARG RACK_ENV 3 | # ARG PORT 4 | ENV APP_HOME /app 5 | # RUN apt-get update -qq && apt-get install -y build-essential 6 | RUN mkdir $APP_HOME 7 | WORKDIR $APP_HOME 8 | ADD . $APP_HOME/ 9 | RUN cask install || cask install 10 | # RUN bundle install — without development test 11 | CMD /bin/sh -c cask exec ert-runner 12 | -------------------------------------------------------------------------------- /test/test-helper.el: -------------------------------------------------------------------------------- 1 | ;;; test-helper --- Test helper for paradox 2 | 3 | ;;; Commentary: 4 | ;; test helper inspired from https://github.com/tonini/overseer.el/blob/master/test/test-helper.el 5 | 6 | ;;; Code: 7 | 8 | (unless (bound-and-true-p package--initialized) 9 | (setq 10 | package-user-dir (expand-file-name 11 | (format "../.cask/%s/elpa" emacs-version) 12 | (file-name-directory load-file-name))) 13 | 14 | (package-initialize)) 15 | 16 | (require 'ert) 17 | (require 'undercover) 18 | (undercover "*.el") 19 | (require 'paradox) 20 | 21 | ;;; test-helper.el ends here 22 | -------------------------------------------------------------------------------- /.github/main.workflow: -------------------------------------------------------------------------------- 1 | workflow "Test and deploy to Heroku" { 2 | resolves = [ 3 | "docker.test", 4 | "docker.build", 5 | "filter.master", 6 | ] 7 | on = "push" 8 | } 9 | 10 | action "docker.build" { 11 | uses = "actions/docker/cli@master" 12 | args = "build -f Dockerfile -t ci-$GITHUB_SHA:latest ." 13 | needs = ["filter.master"] 14 | } 15 | 16 | action "docker.test" { 17 | uses = "actions/docker/cli@master" 18 | args = "run ci-$GITHUB_SHA:latest" 19 | needs = ["docker.build"] 20 | } 21 | 22 | action "filter.master" { 23 | uses = "actions/bin/filter@3c0b4f0e63ea54ea5df2914b4fabf383368cd0da" 24 | args = "branch master" 25 | } 26 | -------------------------------------------------------------------------------- /helpers/run.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash -ex 2 | 3 | if [[ -z "$EMACS" ]]; then 4 | echo "NO EMACS!!"; 5 | exit 1; 6 | else 7 | # Paradox 8 | cd ~/.paradox 9 | git fetch origin 10 | git checkout data &> /dev/null 11 | git pull &> /dev/null 12 | git merge origin/master 13 | cd ~/.paradox/helpers 14 | /usr/bin/nice $EMACS --batch -Q \ 15 | -L . -L .. -l paradox-counter.el \ 16 | --eval '(setq debug-on-error t)' \ 17 | -f paradox-generate-star-count 18 | git add .. &> /dev/null 19 | git commit -m "$(date)" &> /dev/null 20 | git push -v origin data:refs/heads/data &> /dev/null; 21 | fi 22 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # This makefile runs the tests as Travis runs them. Be sure to test 2 | # locally before you push if you are under the impression that the 3 | # patch should work. This will cut down on the number of commits in 4 | # the repository that, essentially, patch patches. 5 | # 6 | # To test Emacs 24.1, for example, use 7 | # 8 | # make 24.1 9 | # 10 | # To test on all versions, of course, simply use 11 | # 12 | # make 13 | # 14 | # or 15 | # 16 | # make all 17 | # 18 | 19 | VERSIONS = 24.2 24.3 24.4 24.5 25.1 20 | 21 | all :: $(VERSIONS) 22 | 23 | $(VERSIONS) :: clean 24 | evm install emacs-$@-bin --skip || true 25 | evm use emacs-$@-bin 26 | emacs --version 27 | cask install 28 | cask exec ert-runner 29 | 30 | clean: 31 | rm -rf .sx/ 32 | cask clean-elc 33 | 34 | install_cask: 35 | curl -fsSkL https://raw.github.com/cask/cask/master/go | python 36 | 37 | install_evm: 38 | curl -fsSkL https://raw.github.com/rejeep/evm/master/go | bash 39 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: generic 2 | sudo: false 3 | before_install: 4 | - curl -fsSkL https://gist.github.com/rejeep/ebcd57c3af83b049833b/raw > x.sh && source ./x.sh 5 | - evm install $EVM_EMACS --use --skip 6 | - cask 7 | env: 8 | - EVM_EMACS=emacs-24.2-travis 9 | - EVM_EMACS=emacs-24.3-travis 10 | - EVM_EMACS=emacs-24.4-travis 11 | - EVM_EMACS=emacs-24.5-travis 12 | - EVM_EMACS=emacs-25.1-travis 13 | - EVM_EMACS=emacs-git-snapshot-travis 14 | 15 | matrix: 16 | fast_finish: true 17 | allow_failures: 18 | - env: EVM_EMACS=emacs-24.2-travis 19 | - env: EVM_EMACS=emacs-24.3-travis 20 | - env: EVM_EMACS=emacs-25.1-travis 21 | - env: EVM_EMACS=emacs-git-snapshot-travis 22 | script: 23 | - emacs --version 24 | - cask exec ert-runner 25 | 26 | notifications: 27 | webhooks: 28 | urls: 29 | on_success: change # options: [always|never|change] default: always 30 | on_failure: always # options: [always|never|change] default: always 31 | on_start: false # default: false 32 | -------------------------------------------------------------------------------- /test/paradox-test.el: -------------------------------------------------------------------------------- 1 | (ert-deftest message () 2 | "" 3 | (should 4 | (string= 5 | (paradox--format-message 'question '(1) '(1 2)) 6 | "Install 1 package, and Delete 2 packages? ")) 7 | (should 8 | (string= 9 | (paradox--format-message 'question nil '(1 2)) 10 | "Delete 2 packages? ")) 11 | (should 12 | (string= 13 | (paradox--format-message 'question '(1) nil) 14 | "Install 1 package? ")) 15 | (should 16 | (string= 17 | (paradox--format-message nil '(1) '(1 2)) 18 | "Installed 1 package, and Deleted 2 packages.")) 19 | (should 20 | (string= 21 | (paradox--format-message nil nil '(1 2)) 22 | "Deleted 2 packages.")) 23 | (should 24 | (string= 25 | (paradox--format-message nil '(1) nil) 26 | "Installed 1 package."))) 27 | 28 | (ert-deftest sanity () 29 | "" 30 | (let ((paradox-github-token t)) 31 | (should (progn (paradox-list-packages nil) t))) 32 | ;; (let ((paradox-github-token "okokok")) 33 | ;; (should-error (progn (paradox-list-packages nil) t))) 34 | ) 35 | -------------------------------------------------------------------------------- /helpers/paradox-counter.el: -------------------------------------------------------------------------------- 1 | ;;; paradox-counter.el --- Functions for counting the number of stars on each github emacs package. 2 | 3 | ;; Copyright (C) 2014 Artur Malabarba 4 | 5 | ;; Author: Artur Malabarba 6 | ;; URL: http://github.com/Bruce-Connor/paradox 7 | ;; Version: 0.1 8 | ;; Prefix: paradox 9 | ;; Separator: - 10 | ;; Requires: paradox 11 | 12 | ;;; License: 13 | ;; 14 | ;; This file is NOT part of GNU Emacs. 15 | ;; 16 | ;; This program is free software; you can redistribute it and/or 17 | ;; modify it under the terms of the GNU General Public License 18 | ;; as published by the Free Software Foundation; either version 2 19 | ;; of the License, or (at your option) any later version. 20 | ;; 21 | ;; This program is distributed in the hope that it will be useful, 22 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 23 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 24 | ;; GNU General Public License for more details. 25 | ;; 26 | 27 | ;;; Change Log: 28 | ;; 0.1 - 2014/04/03 - Generator complete. 29 | ;; 0.1 - 2014/04/03 - Created File. 30 | ;;; Code: 31 | 32 | 33 | (require 'paradox-github) 34 | (require 'json) 35 | (eval-when-compile (require 'cl)) 36 | 37 | (defcustom paradox-melpa-directory 38 | (expand-file-name "~/.melpa/") 39 | "Directory with melpa package recipes." 40 | :type 'directory 41 | :group 'paradox) 42 | (defcustom paradox-download-count-url 43 | "http://melpa.org/download_counts.json" 44 | "" 45 | :type 'string 46 | :group 'paradox) 47 | 48 | (defvar paradox--output-data-file-old 49 | (expand-file-name "../data") 50 | "File where lists will be saved.") 51 | 52 | (defcustom paradox--output-data-file 53 | (expand-file-name "../data-hashtables") 54 | "File where hashtables will be saved." 55 | :type 'file 56 | :group 'paradox-counter 57 | :package-version '(paradox-counter . "0.1")) 58 | 59 | (defun paradox-log (&rest s) 60 | (princ (concat (apply #'format s) "\n") t)) 61 | 62 | (defun paradox-list-to-file () 63 | "Save lists in \"data\" file." 64 | (with-temp-file paradox--output-data-file 65 | (pp paradox--star-count (current-buffer)) 66 | (pp paradox--package-repo-list (current-buffer)) 67 | (pp paradox--download-count (current-buffer)) 68 | (pp paradox--wiki-packages (current-buffer)))) 69 | 70 | (defun paradox-fetch-star-count (repo) 71 | (cdr (assq 'stargazers_count 72 | (paradox--github-action (format "repos/%s" repo) 73 | :reader #'json-read)))) 74 | 75 | 76 | ;;;###autoload 77 | (defun paradox-generate-star-count (&optional _recipes-dir) 78 | "Get the number of stars for each github repo and return. 79 | Also saves result to `package-star-count'" 80 | (interactive) 81 | (setq paradox-github-token 82 | (or (getenv "GHTOKEN") paradox-github-token)) 83 | (require 'json) 84 | (let ((json-key-type 'symbol) 85 | (json-object-type 'hash-table)) 86 | (setq paradox--download-count 87 | (paradox--github-action paradox-download-count-url :reader #'json-read))) 88 | (let ((table-size (hash-table-count paradox--download-count))) 89 | (setq paradox--wiki-packages (make-hash-table :size table-size)) 90 | (setq paradox--package-repo-list (make-hash-table :size table-size)) 91 | (setq paradox--star-count (make-hash-table :size table-size))) 92 | (with-current-buffer (let ((inhibit-message t)) 93 | (url-retrieve-synchronously "http://melpa.org/recipes.json")) 94 | (search-forward "\n\n") 95 | (let ((i 0) 96 | (paradox--github-errors-to-ignore '(403 404))) 97 | (dolist (it (json-read)) 98 | (redisplay) 99 | (ignore-errors 100 | (let ((name (car it))) 101 | (let-alist (cdr it) 102 | (paradox-log "%s / %s" (incf i) name) 103 | (pcase .fetcher 104 | (`"github" 105 | (let ((count (paradox-fetch-star-count .repo))) 106 | (if (numberp count) 107 | (progn 108 | (puthash name count paradox--star-count) 109 | (puthash name .repo paradox--package-repo-list)) 110 | (paradox-log "FAILED: %s / %s" i name)))) 111 | (`"wiki" 112 | (puthash name t paradox--wiki-packages))))))))) 113 | (paradox-list-to-file)) 114 | 115 | (provide 'paradox-counter) 116 | ;;; paradox-counter.el ends here. 117 | -------------------------------------------------------------------------------- /paradox-core.el: -------------------------------------------------------------------------------- 1 | ;;; paradox-core.el --- common functions -*- lexical-binding:t -*- 2 | 3 | ;; Copyright (C) 2014-2015 Artur Malabarba 4 | 5 | ;; Author: Artur Malabarba 6 | ;; Prefix: paradox 7 | ;; Separator: - 8 | 9 | ;;; License: 10 | ;; 11 | ;; This file is NOT part of GNU Emacs. 12 | ;; 13 | ;; This program is free software; you can redistribute it and/or 14 | ;; modify it under the terms of the GNU General Public License 15 | ;; as published by the Free Software Foundation; either version 2 16 | ;; of the License, or (at your option) any later version. 17 | ;; 18 | ;; This program is distributed in the hope that it will be useful, 19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 21 | ;; GNU General Public License for more details. 22 | ;; 23 | 24 | ;;; Code: 25 | (require 'subr-x) 26 | 27 | 28 | ;;; Configurations 29 | (defface paradox-comment-face 30 | '((((background light)) :foreground "Grey30") 31 | (((background dark)) :foreground "Grey60")) 32 | "Face used on faded out stuff." 33 | :group 'paradox-menu 34 | :group 'paradox-commit-list) 35 | (defface paradox-highlight-face 36 | '((t :weight bold :inherit font-lock-variable-name-face)) 37 | "Face used on highlighted stuff." 38 | :group 'paradox-menu 39 | :group 'paradox-commit-list) 40 | 41 | 42 | ;;; Internal variables 43 | (defvar paradox--star-count (make-hash-table)) 44 | (defvar paradox--download-count (make-hash-table)) 45 | (defvar paradox--package-repo-list (make-hash-table)) 46 | (defvar paradox--wiki-packages (make-hash-table)) 47 | 48 | (defconst paradox--data-url 49 | "https://raw.githubusercontent.com/Malabarba/paradox/data/" 50 | "Address of Paradox's data directory.") 51 | 52 | (defconst paradox--star-count-url (concat paradox--data-url "data-hashtables") 53 | "Address of the raw star-count file.") 54 | (make-obsolete-variable 'paradox--star-count-url 'paradox--data-url "2.1") 55 | 56 | (defconst paradox--package-count 57 | '(("total" . 0) ("built-in" . 0) 58 | ("obsolete" . 0) ("deleted" . 0) 59 | ("available" . 0) ("new" . 0) 60 | ("held" . 0) ("disabled" . 0) 61 | ("dependency" . 0) ("avail-obso" . 0) 62 | ("incompat" . 0) ("external" . 0) 63 | ("installed" . 0) ("unsigned" . 0))) 64 | 65 | (defmacro paradox--cas (string) 66 | "Same as (cdr (assoc-string ,STRING paradox--package-count))." 67 | `(cdr (assoc-string ,string paradox--package-count))) 68 | 69 | (defun paradox--truncate-string-to-width-filter (args) 70 | "Filter the args of `truncate-string-to-width' to use \"…\". 71 | All arguments STR, END-COLUMN, START-COLUMN, PADDING, and 72 | ELLIPSIS are passed to `truncate-string-to-width'." 73 | (when (and (eq major-mode 'paradox-menu-mode) 74 | (eq t (nth 4 args))) 75 | (setf (nth 4 args) (if (char-displayable-p ?…) "…" "$"))) 76 | args) 77 | 78 | 79 | ;;; Overriding definitions 80 | (defvar paradox--backups nil) 81 | 82 | (defun paradox--core-enable () 83 | "Enable core features." 84 | (ignore-errors (setcdr (assq 'menu-bar package-menu-mode-map) nil)) 85 | (advice-add #'truncate-string-to-width :filter-args 86 | #'paradox--truncate-string-to-width-filter 87 | '((name . :paradox-override))) 88 | (add-to-list 'paradox--backups 'truncate-string-to-width)) 89 | 90 | (defun paradox-disable () 91 | "Disable paradox, and go back to regular package-menu." 92 | (interactive) 93 | (when paradox--backups 94 | (message "Restoring %s" (mapconcat #'symbol-name paradox--backups ", ")) 95 | (dolist (it paradox--backups) 96 | (advice-remove it :paradox-override)) 97 | (setq paradox--backups nil))) 98 | 99 | (defun paradox--override-definition (sym newdef) 100 | "Temporarily override SYM's function definition with NEWDEF. 101 | Record that in `paradox--backups', but do nothing if 102 | `paradox--backups' reports that it is already overriden." 103 | (unless (memq sym paradox--backups) 104 | (message "Overriding %s with %s" sym newdef) 105 | (advice-add sym :override newdef '((name . :paradox-override))) 106 | (add-to-list 'paradox--backups sym))) 107 | 108 | 109 | ;;; Pre 25.1 support 110 | (defun paradox--update-downloads-in-progress (&optional name) 111 | (if (and name (fboundp 'package--update-downloads-in-progress)) 112 | (package--update-downloads-in-progress name) 113 | (when (bound-and-true-p package--downloads-in-progress) 114 | (setq package--downloads-in-progress 115 | (remove name package--downloads-in-progress))))) 116 | (define-obsolete-function-alias 117 | 'paradox--pdate-downloads-in-progress 118 | 'paradox--update-downloads-in-progress 119 | "2.1") 120 | 121 | 122 | ;;; Spinner 123 | (defvar paradox--spinner nil) 124 | 125 | (eval-and-compile (require 'spinner)) 126 | (defcustom paradox-spinner-type 'horizontal-moving 127 | "Holds the type of spinner to be used in the mode-line. 128 | Takes a value accepted by `spinner-start'." 129 | :type `(choice (choice :tag "Choose a spinner by name" 130 | ,@(mapcar (lambda (c) (list 'const (car c))) 131 | spinner-types)) 132 | (const :tag "A random spinner" random) 133 | (repeat :tag "A list of symbols from `spinner-types' to randomly choose from" 134 | (choice :tag "Choose a spinner by name" 135 | ,@(mapcar (lambda (c) (list 'const (car c))) 136 | spinner-types))) 137 | (vector :tag "A user defined vector" 138 | (repeat :inline t string))) 139 | :package-version '(paradox . "2.1") 140 | :group 'paradox-execute) 141 | 142 | (defun paradox--start-spinner () 143 | (when (spinner-p paradox--spinner) 144 | (spinner-stop paradox--spinner)) 145 | (setq paradox--spinner 146 | (make-spinner paradox-spinner-type t 10)) 147 | (spinner-start paradox--spinner)) 148 | 149 | (defun paradox--stop-spinner () 150 | (when (spinner-p paradox--spinner) 151 | (spinner-stop paradox--spinner)) 152 | (setq paradox--spinner nil)) 153 | 154 | (provide 'paradox-core) 155 | ;;; paradox-core.el ends here. 156 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | This package has been Archived 2 | ======= 3 | It is no longer being maintained. 4 | 5 | Paradox 6 | ======= 7 | 8 | [![Build Status](https://secure.travis-ci.org/Malabarba/paradox.svg?branch=master)](http://travis-ci.org/Malabarba/paradox) 9 | [![Melpa](http://melpa.org/packages/paradox-badge.svg)](http://melpa.org/#/paradox) 10 | [![Melpa-stable](http://stable.melpa.org/packages/paradox-badge.svg)](http://melpa.org/#/paradox) 11 | [![Coverage Status](https://coveralls.io/repos/Malabarba/paradox/badge.svg)](https://coveralls.io/r/Malabarba/paradox) 12 | [![License](http://img.shields.io/:license-gpl3-blue.svg)](http://www.gnu.org/licenses/gpl-3.0.html) 13 | 14 | [![Gratipay](https://cdn.rawgit.com/gratipay/gratipay-badge/2.3.0/dist/gratipay.svg)](https://gratipay.com/endless-parentheses) 15 | 16 | Project for modernizing Emacs' Package Menu. With improved appearance, 17 | mode-line information. Github integration, customizability, 18 | asynchronous upgrading, and more. 19 | 20 | Here are some visual comparisons: 21 | 22 | #### Regular Package Menu #### 23 | ![Regular Package Menu](before.png) 24 | 25 | #### Paradox #### 26 | ![Paradox Package Menu](after.png) 27 | 28 | #### Paradox (multi-line) #### 29 | ![Paradox Package Menu](multi-line.png) 30 | *These screenshots use smart-mode-line, but a similar effect is obtained with the regular mode-line.* 31 | 32 | Usage 33 | === 34 | 35 | Paradox can be installed from Melpa with 36 | 37 | M-x package-install RET paradox 38 | 39 | It can also be installed manually in the usual way, just be mindful of 40 | the dependencies. 41 | 42 | To use it, simply call `M-x paradox-list-packages` (instead of the 43 | regular `list-packages`). 44 | This will give you most features out of the box. If you want to be 45 | able to star packages as well, just configure the 46 | `paradox-github-token` variable then call `paradox-list-packages` 47 | again. 48 | 49 | If you'd like to stop using Paradox, you may call `paradox-disable` 50 | (or just restart Emacs) and go back to using the regular 51 | `list-packages`. 52 | 53 | ### Use Paradox as the Default Interface 54 | In order to use the Paradox interface by default (and just having to 55 | call the standard `list-packages` command), add the following in your 56 | init file: 57 | 58 | ```Emacs Lisp 59 | (require 'paradox) 60 | (paradox-enable) 61 | ``` 62 | 63 | ## Current Features ## 64 | 65 | ### Several Improvements ### 66 | 67 | Paradox implements many small improvements to the package menu 68 | itself. They all work out of the box and are completely customizable! 69 | *(Also, hit `h` to see all keys.)* 70 | 71 | * Visit the package's homepage with `v` (or just use the provided buttons). 72 | * View a list of recent commits with `l`. 73 | * Use `paradox-require` instead of `require` to automatically install 74 | absent packages. 75 | * Shortcuts for package filtering: 76 | * `f r` filters by regexp. 77 | * `f u` display only packages with upgrades. 78 | * `f k` filters by keyword. 79 | * `f s` filters by user starred packages. 80 | 81 | And some more... 82 | * `hl-line-mode` enabled by default. 83 | * Display useful information on the mode-line and cleanup a bunch of 84 | useless stuff. 85 | * **Customization!** Just call `M-x paradox-customize` to see what you can 86 | do. 87 | * Customize column widths. 88 | * Customize faces (`paradox-star-face`, 89 | `paradox-status-face-alist` and `paradox-archive-face`). 90 | * Customize local variables. 91 | 92 | 93 | ### Execution Hook ### 94 | 95 | Paradox defines a hook called `paradox-after-execute-functions`. Functions 96 | added to this hook are run whenever packages are installed, deleted, 97 | or upgraded. This is used to implement part of the Paradox 98 | functionality, which makes it very easy to customize and extend. 99 | 100 | - A full report is available at the *\*Paradox Report\** buffer. You 101 | can disable this feature with: 102 | 103 | (remove-hook 'paradox--report-buffer-print 'paradox-after-execute-functions) 104 | 105 | - If the upgrade was performed without querying the user (which 106 | happens when `paradox-execute` is called with a prefix argument), 107 | then the report buffer is displayed at the end. 108 | You can disable this feature with: 109 | 110 | (remove-hook 'paradox--report-buffer-display-if-noquery 'paradox-after-execute-functions) 111 | 112 | - A message is printed in the echo area with a brief summary of the 113 | transaction. You can disable this feature with: 114 | 115 | (remove-hook 'paradox--report-message 'paradox-after-execute-functions) 116 | 117 | ### Package Ratings ### 118 | 119 | Paradox also integrates with 120 | **GitHub Stars**, which works as **rough** package rating system. 121 | That is, Paradox package menu will: 122 | 123 | 1. Display the number of GitHub Stars each package has (assuming it's 124 | in a github repo, of course); 125 | 2. Possibly automatically star packages you install, and unstar 126 | packages you delete (you will be asked the first time whether you 127 | want this); 128 | 3. Let you star and unstar packages by hitting the `s` key; 129 | 4. Let you star all packages you have installed with `M-x paradox-star-all-installed-packages`. 130 | 131 | Item **1.** will work out of the box, the other items obviously 132 | require a github account (Paradox will help you generate a token the 133 | first time you call `paradox-list-packages`). 134 | 135 | ## Known Bugs ## 136 | 137 | * On some cases there's an annoying gnutls error message after downloading the star counts `gnutls.c: [0] (Emacs) fatal error: The TLS connection was non-properly terminated.`. 138 | If anyone knows how to fix it, I'm all ears. 139 | 140 | ## How Star Displaying Works ## 141 | 142 | We generate a map of `Package Name -> Repository` from 143 | [Melpa](https://github.com/milkypostman/melpa.git)'s `recipe` 144 | directory, some repos may correspond to more than one package. 145 | This map is used to count the stars a given package has. 146 | _This doesn't mean you need Melpa to see the star counts, the numbers 147 | will be displayed regardless of what archives you use._ 148 | 149 | Currently, packages that are not hosted on GitHub are listed with a 150 | blank star count, which is clearly different from 0-star packages 151 | (which are displayed with a 0, obviously). 152 | If you know of an alternative that could be used for these packages, 153 | [open an issue](https://github.com/Malabarba/paradox/issues/new) 154 | here, I'd love to hear. 155 | -------------------------------------------------------------------------------- /paradox-commit-list.el: -------------------------------------------------------------------------------- 1 | ;;; paradox-commit-list.el --- listing commits for a package's repository -*- lexical-binding:t -*- 2 | 3 | ;; Copyright (C) 2014-2015 Artur Malabarba 4 | 5 | ;; Author: Artur Malabarba 6 | ;; Prefix: paradox 7 | ;; Separator: - 8 | 9 | ;;; License: 10 | ;; 11 | ;; This file is NOT part of GNU Emacs. 12 | ;; 13 | ;; This program is free software; you can redistribute it and/or 14 | ;; modify it under the terms of the GNU General Public License 15 | ;; as published by the Free Software Foundation; either version 2 16 | ;; of the License, or (at your option) any later version. 17 | ;; 18 | ;; This program is distributed in the hope that it will be useful, 19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 21 | ;; GNU General Public License for more details. 22 | ;; 23 | 24 | 25 | ;;; Code: 26 | (require 'subr-x) 27 | (require 'cl-lib) 28 | (require 'package) 29 | 30 | (require 'paradox-github) 31 | 32 | (defgroup paradox-commit-list nil 33 | "Buffer used by paradox to list commits for a package." 34 | :prefix "paradox-" 35 | :package-version '(paradox . "2.0") 36 | :group 'paradox) 37 | 38 | 39 | ;;; Variables 40 | (defcustom paradox-commit-list-query-max-pages 1 41 | "Max number of pages we read from github when fetching the commit-list. 42 | Each page lists 100 commits, so 1 page should be more than enough 43 | for most repositories. 44 | 45 | Increasing this number consequently multiplies the time it takes 46 | to load the commit list on repos which actually use that many 47 | pages." 48 | :type 'integer 49 | :group 'paradox-commit-list 50 | :package-version '(paradox . "1.2.3")) 51 | 52 | (defcustom paradox-date-format "%Y-%m-%d" 53 | "Format used for the date displayed on the commit list. 54 | See `format-time-string' for more information. 55 | 56 | Set it to \"%x\" for a more \"human\" date format." 57 | :type 'string 58 | :group 'paradox-commit-list 59 | :package-version '(paradox . "1.2.3")) 60 | 61 | (defface paradox-commit-tag-face 62 | '((t :foreground "goldenrod4" 63 | :background "LemonChiffon1" 64 | :box 1)) 65 | "Face used for tags on the commit list." 66 | :group 'paradox-commit-list) 67 | 68 | 69 | ;;; Variables 70 | (defvar paradox--commit-message-face nil 71 | "Face currently being used on commit messages. 72 | Gets dynamically changed to `font-lock-comment-face' on old commits. 73 | nil means `default'.") 74 | 75 | (defvar-local paradox--package-repo nil 76 | "Repo of the package in a commit-list buffer.") 77 | (defvar-local paradox--package-name nil 78 | "Name of the package in a commit-list buffer.") 79 | (defvar-local paradox--package-version nil 80 | "Installed version of the package in a commit-list buffer.") 81 | (defvar-local paradox--package-tag-commit-alist nil 82 | "Alist of (COMMIT-SHA . TAG) for this package's repo.") 83 | 84 | (define-button-type 'paradox-commit 85 | 'action #'paradox-commit-list-visit-commit 86 | 'follow-link t) 87 | 88 | ;; Use `font-lock-face' on creation instead. 89 | (button-type-put 'paradox-commit 'face nil) 90 | 91 | 92 | ;;; Functions 93 | (defun paradox--get-tag-commit-alist (repo) 94 | "Get REPO's tag list and associate them to commit hashes." 95 | (require 'json) 96 | (mapcar 97 | (lambda (x) 98 | (cons 99 | (cdr (assoc 'sha (cdr (assoc 'commit x)))) 100 | (cdr (assoc 'name x)))) 101 | (let ((json-array-type 'list)) 102 | (paradox--github-action 103 | (format "repos/%s/tags?per_page=100" repo) 104 | :reader #'json-read 105 | :max-pages paradox-commit-list-query-max-pages)))) 106 | 107 | (defun paradox--get-installed-version (pkg) 108 | "Return the installed version of PKG. 109 | - If PKG isn't installed, return '(0). 110 | - If it has a Melpa-like version (YYYYMMDD HHMM), return it as a 111 | time value. 112 | - If it has a regular version number, return it as a string." 113 | (let ((desc (cadr (assoc pkg package-alist)))) 114 | (if desc 115 | (let ((version (package-desc-version desc))) 116 | (if (> (car version) 19000000) 117 | (date-to-time 118 | (format "%8dT%02d:%02d" 119 | (car version) 120 | (/ (cadr version) 100) 121 | (% (cadr version) 100))) 122 | ;; Regular version numbers. 123 | (mapconcat 'int-to-string version "."))) 124 | '(0 0)))) 125 | 126 | (defun paradox--commit-tabulated-list (repo) 127 | "Return the tabulated list for REPO's commit list." 128 | (require 'json) 129 | (let* ((paradox--commit-message-face nil) 130 | (json-array-type 'list) 131 | (feed (paradox--github-action 132 | (format "repos/%s/commits?per_page=100" repo) 133 | :reader #'json-read 134 | :max-pages paradox-commit-list-query-max-pages))) 135 | (apply 'append (mapcar 'paradox--commit-print-info feed)))) 136 | 137 | (defun paradox--commit-print-info (x) 138 | "Parse json in X into a tabulated list entry." 139 | (let* ((commit (cdr (assoc 'commit x))) 140 | (date (date-to-time (cdr (assoc 'date (cdr (assoc 'committer commit)))))) 141 | (title (split-string (cdr (assoc 'message commit)) "[\n\r][ \t]*" t)) 142 | ;; (url (cdr (assoc 'html_url commit))) 143 | (cc (cdr (assoc 'comment_count commit))) 144 | (sha (cdr (assoc 'sha x))) 145 | (tag (cdr (assoc-string sha paradox--package-tag-commit-alist)))) 146 | ;; Have we already crossed the installed commit, or is it not even installed? 147 | (unless (or paradox--commit-message-face 148 | (equal '(0) paradox--package-version)) 149 | ;; Is this where we cross to old commits? 150 | (when (paradox--version<= date tag) 151 | (setq paradox--commit-message-face 'paradox-comment-face))) 152 | ;; Return the tabulated list entry. 153 | (cons 154 | ;; The ID 155 | (list `((is-old . ,(null paradox--commit-message-face)) 156 | (lisp-date . ,date) 157 | ,@x) 158 | ;; The actual displayed data 159 | (vector 160 | (make-text-button 161 | (format-time-string paradox-date-format date) nil 162 | 'type 'paradox-commit 163 | 'font-lock-face (or paradox--commit-message-face 'button)) 164 | (concat (if (> cc 0) 165 | (propertize (format "(%s comments) " cc) 166 | 'face 'font-lock-function-name-face) 167 | "") 168 | (if (stringp tag) 169 | (propertize tag 'face 'paradox-commit-tag-face) 170 | "") 171 | (if (stringp tag) " " "") 172 | (propertize (or (car-safe title) "") 173 | 'face paradox--commit-message-face)))) 174 | (mapcar (lambda (m) (list x (vector "" (propertize m 'face paradox--commit-message-face)))) 175 | (cdr title))))) 176 | 177 | (defun paradox--version<= (date version) 178 | "Non-nil if commit at DATE tagged with VERSION is older or equal to `paradox--package-version'." 179 | ;; Melpa date-like versions 180 | (if (listp paradox--package-version) 181 | ;; Installed date >= to commit date 182 | (null (time-less-p paradox--package-version date)) 183 | ;; Regular version numbers. 184 | (and version 185 | (ignore-errors (version<= version paradox--package-version))))) 186 | 187 | (defun paradox--commit-list-update-entries () 188 | "Update entries of current commit-list." 189 | (setq tabulated-list-entries 190 | (paradox--commit-tabulated-list paradox--package-repo))) 191 | 192 | 193 | ;;; Commands 194 | (defun paradox-commit-list-visit-commit (&optional _) 195 | "Visit this commit on GitHub. 196 | IGNORE is ignored." 197 | (interactive) 198 | (when (derived-mode-p 'paradox-commit-list-mode) 199 | (browse-url (cdr (assoc 'html_url (tabulated-list-get-id)))))) 200 | 201 | (defun paradox-previous-commit (&optional n) 202 | "Move to previous commit, which might not be the previous line. 203 | With prefix N, move to the N-th previous commit." 204 | (interactive "p") 205 | (paradox-next-commit (- n))) 206 | 207 | (defun paradox-next-commit (&optional n) 208 | "Move to next commit, which might not be the next line. 209 | With prefix N, move to the N-th next commit." 210 | (interactive "p") 211 | (dotimes (_ (abs n)) 212 | (let ((d (cl-signum n))) 213 | (forward-line d) 214 | (while (looking-at " +") 215 | (forward-line d))))) 216 | 217 | 218 | ;;; Mode definition 219 | (define-derived-mode paradox-commit-list-mode 220 | tabulated-list-mode "Paradox Commit List" 221 | "Major mode for browsing a list of commits. 222 | Letters do not insert themselves; instead, they are commands. 223 | \\ 224 | \\{paradox-commit-list-mode-map}" 225 | (hl-line-mode 1) 226 | (setq tabulated-list-format 227 | `[("Date" ,(length (format-time-string paradox-date-format (current-time))) nil) 228 | ("Message" 0 nil)]) 229 | (setq tabulated-list-padding 1) 230 | (setq tabulated-list-sort-key nil) 231 | (add-hook 'tabulated-list-revert-hook 'paradox--commit-list-update-entries nil t) 232 | (tabulated-list-init-header)) 233 | 234 | (define-key paradox-commit-list-mode-map " " #'paradox-commit-list-visit-commit) 235 | (define-key paradox-commit-list-mode-map "p" #'paradox-previous-commit) 236 | (define-key paradox-commit-list-mode-map "n" #'paradox-next-commit) 237 | 238 | 239 | (provide 'paradox-commit-list) 240 | ;;; paradox-commit-list.el ends here. 241 | -------------------------------------------------------------------------------- /paradox.el: -------------------------------------------------------------------------------- 1 | ;;; paradox.el --- A modern Packages Menu. Colored, with package ratings, and customizable. -*- lexical-binding:t -*- 2 | 3 | ;; Copyright (C) 2014-2015 Artur Malabarba 4 | 5 | ;; Author: Artur Malabarba 6 | ;; URL: https://github.com/Malabarba/paradox 7 | ;; Version: 2.5.5 8 | ;; Keywords: package packages 9 | ;; Package-Requires: ((emacs "24.4") (seq "1.7") (let-alist "1.0.3") (spinner "1.7.3") (hydra "0.13.2")) 10 | ;; Prefix: paradox 11 | ;; Separator: - 12 | 13 | ;;; Commentary: 14 | ;; 15 | ;; Paradox can be installed from Melpa with M-x `package-install' RET 16 | ;; paradox. 17 | ;; It can also be installed manually in the usual way, just be mindful of 18 | ;; the dependencies. 19 | ;; 20 | ;; To use it, simply call M-x `paradox-list-packages' (instead of the 21 | ;; regular `list-packages'). 22 | ;; This will give you most features out of the box. If you want to be 23 | ;; able to star packages as well, just configure the 24 | ;; `paradox-github-token' variable then call `paradox-list-packages' 25 | ;; again. 26 | ;; 27 | ;; If you'd like to stop using Paradox, you may call `paradox-disable' 28 | ;; and go back to using the regular `list-packages'. 29 | ;; 30 | ;; ## Current Features ## 31 | ;; 32 | ;; ### Several Improvements ### 33 | ;; 34 | ;; Paradox implements many small improvements to the package menu 35 | ;; itself. They all work out of the box and are completely customizable! 36 | ;; *(Also, hit `h' to see all keys.)* 37 | ;; 38 | ;; * Visit the package's homepage with `v' (or just use the provided buttons). 39 | ;; * Shortcuts for package filtering: 40 | ;; * filters by regexp (`occur'); 41 | ;; * display only packages with upgrades; 42 | ;; * filters by keyword. 43 | ;; * `hl-line-mode' enabled by default. 44 | ;; * Display useful information on the mode-line and cleanup a bunch of 45 | ;; useless stuff. 46 | ;; * **Customization!** Just call M-x `paradox-customize' to see what you can 47 | ;; do. 48 | ;; * Customize column widths. 49 | ;; * Customize faces (`paradox-star-face', `paradox-status-face-alist' and `paradox-archive-face'). 50 | ;; * Customize local variables. 51 | ;; 52 | ;; ### Package Ratings ### 53 | ;; 54 | ;; Paradox also integrates with 55 | ;; **GitHub Stars**, which works as **rough** package rating system. 56 | ;; That is, Paradox package menu will: 57 | ;; 58 | ;; 1. Display the number of GitHub Stars each package has (assuming it's 59 | ;; in a github repo, of course); 60 | ;; 2. Possibly automatically star packages you install, and unstar 61 | ;; packages you delete (you will be asked the first time whether you 62 | ;; want this); 63 | ;; 3. Let you star and unstar packages by hitting the `s' key; 64 | ;; 4. Let you star all packages you have installed with M-x `paradox-star-all-installed-packages'. 65 | ;; 66 | ;; Item **1.** will work out of the box, the other items obviously 67 | ;; require a github account (Paradox will help you generate a token the 68 | ;; first time you call `paradox-list-packages'). 69 | ;; 70 | ;; ## How Star Displaying Works ## 71 | ;; 72 | ;; We generate a map of Package Name -> Repository from 73 | ;; [Melpa](https://github.com/milkypostman/melpa.git)'s `recipe' 74 | ;; directory, some repos may correspond to more than one package. 75 | ;; This map is used count the stars a given package has. 76 | ;; _This doesn't mean you need Melpa to see the star counts, the numbers 77 | ;; will be displayed regardless of what archives you use._ 78 | ;; 79 | ;; Currently, packages that are not hosted on GitHub are listed with a 80 | ;; blank star count, which is clearly different from 0-star packages 81 | ;; (which are displayed with a 0, obviously). 82 | ;; If you know of an alternative that could be used for these packages, 83 | ;; [open an issue](https://github.com/Bruce-Connor/paradox/issues/new) 84 | ;; here, I'd love to hear. 85 | 86 | ;;; License: 87 | ;; 88 | ;; This file is NOT part of GNU Emacs. 89 | ;; 90 | ;; This program is free software; you can redistribute it and/or 91 | ;; modify it under the terms of the GNU General Public License 92 | ;; as published by the Free Software Foundation; either version 2 93 | ;; of the License, or (at your option) any later version. 94 | ;; 95 | ;; This program is distributed in the hope that it will be useful, 96 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 97 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 98 | ;; GNU General Public License for more details. 99 | 100 | 101 | ;;; Code: 102 | 103 | (require 'package) 104 | (require 'cl-lib) 105 | 106 | (require 'paradox-core) 107 | (require 'paradox-execute) 108 | (require 'paradox-menu) 109 | 110 | (defconst paradox-version "2.5.4" "Version of the paradox.el package.") 111 | (defun paradox-bug-report () 112 | "Opens github issues page in a web browser. Please send any bugs you find. 113 | Please include your Emacs and paradox versions." 114 | (interactive) 115 | (message "Your paradox-version is: %s, and your emacs version is: %s.\nPlease include this in your report!" 116 | paradox-version emacs-version) 117 | (browse-url "https://github.com/Bruce-Connor/paradox/issues/new")) 118 | (defun paradox-customize () 119 | "Open the customization menu in the `paradox' group." 120 | (interactive) 121 | (customize-group 'paradox t)) 122 | (defgroup paradox nil 123 | "Customization group for paradox." 124 | :prefix "paradox-" 125 | :group 'emacs 126 | :package-version '(paradox . "0.1")) 127 | 128 | 129 | ;;; External Commands 130 | ;;;###autoload 131 | (defun paradox-list-packages (no-fetch) 132 | "Improved version of `package-list-packages'. The heart of Paradox. 133 | Function is equivalent to `package-list-packages' (including the 134 | prefix NO-FETCH), but the resulting Package Menu is improved in 135 | several ways. 136 | 137 | Among them: 138 | 139 | 1. Uses `paradox-menu-mode', which has more functionality and 140 | keybinds than `package-menu-mode'. 141 | 142 | 2. Uses some font-locking to improve readability. 143 | 144 | 3. Optionally shows the number GitHub stars and Melpa downloads 145 | for packages. 146 | 147 | 4. Adds useful information in the mode-line." 148 | (interactive "P") 149 | (when (paradox--check-github-token) 150 | (paradox-enable) 151 | (let ((is-25 (fboundp 'package--with-response-buffer))) 152 | (unless no-fetch 153 | (unless is-25 154 | (paradox--refresh-remote-data))) 155 | (package-list-packages no-fetch) 156 | (unless no-fetch 157 | (when is-25 158 | (add-to-list 'package--downloads-in-progress 'paradox--data) 159 | (paradox--refresh-remote-data)) 160 | (when (stringp paradox-github-token) 161 | (paradox--refresh-user-starred-list 162 | (bound-and-true-p package-menu-async))))))) 163 | 164 | ;;;###autoload 165 | (defun paradox-upgrade-packages (&optional no-fetch) 166 | "Upgrade all packages. No questions asked. 167 | This function is equivalent to `list-packages', followed by a 168 | `package-menu-mark-upgrades' and a `package-menu-execute'. Except 169 | the user isn't asked to confirm deletion of packages. 170 | 171 | If `paradox-execute-asynchronously' is non-nil, part of this 172 | operation may be performed in the background. 173 | 174 | The NO-FETCH prefix argument is passed to `list-packages'. It 175 | prevents re-download of information about new versions. It does 176 | not prevent downloading the actual packages (obviously)." 177 | (interactive "P") 178 | (save-window-excursion 179 | (let ((package-menu-async nil)) 180 | (paradox-list-packages no-fetch)) 181 | (package-menu-mark-upgrades) 182 | (paradox-menu-execute 'noquery))) 183 | 184 | ;;;###autoload 185 | (defun paradox-enable () 186 | "Enable paradox, overriding the default package-menu." 187 | (interactive) 188 | (when (and (fboundp 'package--update-downloads-in-progress) 189 | (not (fboundp 'package--with-response-buffer))) 190 | (message "[Paradox] Your Emacs snapshot is outdated, please install a more recent one.") 191 | (setq package-menu-async nil)) 192 | (paradox--override-definition 'package-menu--print-info 'paradox--print-info) 193 | (when (fboundp 'package-menu--print-info-simple) 194 | (paradox--override-definition 'package-menu--print-info-simple 'paradox--print-info)) 195 | (paradox--override-definition 'package-menu--generate 'paradox--generate-menu) 196 | ;; Tough it may not look like it, this is totally necessary too. 197 | (paradox--override-definition 'package-menu-mode 'paradox-menu-mode) 198 | (paradox--core-enable)) 199 | 200 | ;;;###autoload 201 | (defun paradox-require (feature &optional filename noerror package refresh) 202 | "Like `require', but also install FEATURE if it is absent. 203 | FILENAME is passed to `require'. 204 | If NOERROR is non-nil, don't complain if the feature couldn't be 205 | installed, just return nil. 206 | 207 | - If FEATURE is present, `require' it and return t. 208 | 209 | - If FEATURE is not present, install PACKAGE with `package-install'. 210 | If PACKAGE is nil, assume FEATURE is the package name. 211 | After installation, `require' FEATURE. 212 | 213 | By default, the current package database is only updated if it is 214 | empty. Passing a non-nil REFRESH argument forces this update." 215 | (or (require feature filename t) 216 | (let ((package (or package 217 | (if (stringp feature) 218 | (intern feature) 219 | feature)))) 220 | (require 'package) 221 | (unless (and package-archive-contents (null refresh)) 222 | (package-refresh-contents)) 223 | (and (condition-case e 224 | (package-install package) 225 | (error (if noerror nil (error (cadr e))))) 226 | (require feature filename noerror))))) 227 | 228 | (provide 'paradox) 229 | ;;; paradox.el ends here 230 | -------------------------------------------------------------------------------- /paradox-execute.el: -------------------------------------------------------------------------------- 1 | ;;; paradox-execute.el --- executing package transactions -*- lexical-binding:t -*- 2 | 3 | ;; Copyright (C) 2014-2015 Artur Malabarba 4 | 5 | ;; Author: Artur Malabarba 6 | ;; Prefix: paradox 7 | ;; Separator: - 8 | 9 | ;;; License: 10 | ;; 11 | ;; This file is NOT part of GNU Emacs. 12 | ;; 13 | ;; This program is free software; you can redistribute it and/or 14 | ;; modify it under the terms of the GNU General Public License 15 | ;; as published by the Free Software Foundation; either version 2 16 | ;; of the License, or (at your option) any later version. 17 | ;; 18 | ;; This program is distributed in the hope that it will be useful, 19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 21 | ;; GNU General Public License for more details. 22 | ;; 23 | 24 | ;;; Commentary: 25 | ;; 26 | ;; Functions related to executing package-menu transactions. 27 | ;; Everything that happens when you hit `x' is in here. 28 | 29 | 30 | ;;; Code: 31 | (require 'cl-lib) 32 | (require 'seq) 33 | 34 | (require 'package) 35 | (require 'paradox-core) 36 | (require 'paradox-github) 37 | 38 | (defgroup paradox-execute nil 39 | "Paradox Packages Menu configurations." 40 | :prefix "paradox-" 41 | :package-version '(paradox . "2.0") 42 | :group 'paradox) 43 | 44 | (defvar paradox--current-filter) 45 | 46 | ;;; Customization Variables 47 | (defcustom paradox-execute-asynchronously 'ask 48 | "Whether the install/delete/upgrade should be asynchronous. 49 | Possible values are: 50 | t, which means always; 51 | nil, which means never; 52 | ask, which means ask each time." 53 | :type '(choice (const :tag "Always" t) 54 | (const :tag "Never" nil) 55 | (const :tag "Ask each time" ask)) 56 | :package-version '(paradox . "2.0") 57 | :group 'paradox-execute) 58 | 59 | (defcustom paradox-async-display-buffer-function #'display-buffer 60 | "Function used to display *Paradox Report* buffer after asynchronous upgrade. 61 | Set this to nil to avoid displaying the buffer. Or set this to a 62 | function like `display-buffer' or `pop-to-buffer'. 63 | 64 | This is only used if `paradox-menu-execute' was given a non-nil 65 | NOQUERY argument. Otherwise, only a message is displayed." 66 | :type '(choice (const :tag "Don't display the buffer" nil) 67 | function) 68 | :package-version '(paradox . "2.0") 69 | :group 'paradox-execute) 70 | 71 | 72 | ;;; Execution Hook 73 | (defvar paradox-after-execute-functions nil 74 | "List of functions run after performing package transactions. 75 | These are run after a set of installation, deletion, or upgrades 76 | has been performed. Each function in this hook must take a single 77 | argument. An associative list of the form 78 | 79 | ((SYMBOL . DATA) (SYMBOL . DATA) ...) 80 | 81 | This list contains the following entries, describing what 82 | occurred during the execution: 83 | 84 | SYMBOL DATA 85 | `installed' List of installed packages. 86 | `deleted' List of deleted packages. 87 | `activated' List of activated packages. 88 | `error' List of errors. 89 | `async' Non-nil if transaction was performed asynchronously. 90 | `noquery' The NOQUERY argument given to `paradox-menu-execute'.") 91 | (put 'risky-local-variable-p 'paradox-after-execute-functions t) 92 | (mapc (lambda (x) (add-hook 'paradox-after-execute-functions x t)) 93 | '(paradox--activate-if-asynchronous 94 | paradox--refresh-package-buffer 95 | paradox--report-buffer-print 96 | paradox--report-buffer-display-if-noquery 97 | paradox--report-message 98 | )) 99 | 100 | (defun paradox--refresh-package-buffer (_) 101 | "Refresh the *Packages* buffer, if it exists." 102 | (let ((buf (get-buffer "*Packages*"))) 103 | (when (buffer-live-p buf) 104 | (with-current-buffer buf 105 | (revert-buffer))))) 106 | 107 | (defun paradox--activate-if-asynchronous (alist) 108 | "Activate packages after an asynchronous operation. 109 | Argument ALIST describes the operation." 110 | (let-alist alist 111 | (when .async 112 | (dolist (pkg .activated) 113 | (if (fboundp 'package--list-loaded-files) 114 | (package-activate-1 pkg 'reload) 115 | (package-activate-1 pkg)))))) 116 | 117 | (defun paradox--print-package-list (list) 118 | "Print LIST at point." 119 | (let* ((width (apply #'max 120 | (mapcar (lambda (x) (string-width (symbol-name (package-desc-name x)))) 121 | list))) 122 | (tabulated-list-format 123 | `[("Package" ,(1+ width) nil) 124 | ("Version" 0 nil)]) 125 | (tabulated-list-padding 2)) 126 | (mapc 127 | (lambda (p) (tabulated-list-print-entry 128 | p 129 | `[,(symbol-name (package-desc-name p)) 130 | ,(package-version-join (package-desc-version p))])) 131 | list))) 132 | 133 | (defun paradox--report-buffer-print (alist) 134 | "Print a transaction report in *Package Report* buffer. 135 | Possibly display the buffer or message the user depending on the 136 | situation. 137 | Argument ALIST describes the operation." 138 | (let-alist alist 139 | (let ((buf (get-buffer-create "*Paradox Report*")) 140 | (inhibit-read-only t)) 141 | (with-current-buffer buf 142 | (goto-char (point-max)) 143 | ;; TODO: Write our own mode for this. 144 | (special-mode) 145 | (insert "\n \n") 146 | (save-excursion 147 | (insert (format-time-string "Package transaction finished. %c\n")) 148 | (when .error 149 | (insert "Errors:\n ") 150 | (dolist (it .error) 151 | (princ it (current-buffer)) 152 | (insert "\n")) 153 | (insert "\n\n")) 154 | (when .installed 155 | (insert "Installed:\n") 156 | (paradox--print-package-list .installed) 157 | (insert "\n")) 158 | (when .deleted 159 | (insert "Deleted:\n") 160 | (paradox--print-package-list .deleted) 161 | (insert "\n"))))))) 162 | 163 | (defun paradox--report-buffer-display-if-noquery (alist) 164 | "Display report buffer if `paradox-execute' was called with a NOQUERY prefix. 165 | ALIST describes the transaction. 166 | `paradox-async-display-buffer-function' is used if transaction 167 | was asynchronous. Otherwise, `pop-to-buffer' is used." 168 | (let-alist alist 169 | ;; The user has never seen the packages in this transaction. So 170 | ;; we display them in a buffer. 171 | (when (or .noquery .error) 172 | (let ((buf (get-buffer "*Paradox Report*"))) 173 | (when (buffer-live-p buf) 174 | (cond 175 | ;; If we're async, the user might be doing something else, so 176 | ;; we don't steal focus. 177 | ((and .async paradox-async-display-buffer-function) 178 | (funcall paradox-async-display-buffer-function buf)) 179 | ;; If we're not async, just go ahead and pop. 180 | ((or (not .async) 181 | ;; If there's an error, display the buffer even if 182 | ;; `paradox-async-display-buffer-function' is nil. 183 | .error) 184 | (pop-to-buffer buf)))))))) 185 | 186 | (defun paradox--report-message (alist) 187 | "Message the user about the executed transaction. 188 | ALIST describes the transaction." 189 | (let-alist alist 190 | (message "%s%s" 191 | (paradox--format-message nil .installed .deleted) 192 | (if (memq 'paradox--report-buffer-print paradox-after-execute-functions) 193 | " See the buffer *Paradox Report* for more details." "")) 194 | (when .errors 195 | (message "Errors encountered during the operation: %S\n%s" 196 | .errors 197 | (if (memq 'paradox--report-buffer-print paradox-after-execute-functions) 198 | " See the buffer *Paradox Report* for more details." ""))))) 199 | 200 | 201 | ;;; Execution 202 | (defun paradox-menu-execute (&optional noquery) 203 | "Perform marked Package Menu actions. 204 | Packages marked for installation are downloaded and installed; 205 | packages marked for deletion are removed. 206 | 207 | Afterwards, if `paradox-automatically-star' is t, automatically 208 | star new packages, and unstar removed packages. Upgraded packages 209 | aren't changed. 210 | 211 | Synchronicity of the actions depends on 212 | `paradox-execute-asynchronously'. Optional argument NOQUERY 213 | non-nil means do not ask the user to confirm. If asynchronous, 214 | never ask anyway." 215 | (interactive "P") 216 | (unless (derived-mode-p 'paradox-menu-mode) 217 | (error "The current buffer is not in Paradox Menu mode")) 218 | (when (and (stringp paradox-github-token) 219 | (eq paradox-automatically-star 'unconfigured)) 220 | (customize-save-variable 221 | 'paradox-automatically-star 222 | (y-or-n-p "When you install new packages would you like them to be automatically starred? 223 | \(They will be unstarred when you delete them) "))) 224 | (when (and (stringp paradox--current-filter) 225 | (string-match "Upgradable" paradox--current-filter)) 226 | (setq tabulated-list-sort-key '("Status" . nil)) 227 | (setq paradox--current-filter nil)) 228 | (paradox--menu-execute-1 noquery)) 229 | 230 | (defmacro paradox--perform-package-transaction (install delete) 231 | "Install all packages from INSTALL and delete those from DELETE. 232 | Return an alist with properties listing installed, 233 | deleted, and activated packages, and errors." 234 | `(let (activated installed deleted errored) 235 | (advice-add #'package-activate-1 :after 236 | (lambda (pkg &rest _) 237 | (ignore-errors (push pkg activated))) 238 | '((name . paradox--track-activated))) 239 | (condition-case err 240 | (progn 241 | (dolist (pkg ,install) 242 | ;; 2nd arg introduced in 25. 243 | (if (version<= "25" emacs-version) 244 | (package-install pkg 'dont-select) 245 | (package-install pkg)) 246 | (push pkg installed)) 247 | (let ((delete-list ,delete)) 248 | (dolist (pkg (if (fboundp 'package--sort-by-dependence) 249 | (package--sort-by-dependence delete-list) 250 | delete-list)) 251 | (condition-case err 252 | (progn (package-delete pkg) 253 | (push pkg deleted)) 254 | (error (push err errored)))))) 255 | (error (push err errored))) 256 | (advice-remove #'package-activate-1 'paradox--track-activated) 257 | (list (cons 'installed (nreverse installed)) 258 | (cons 'deleted (nreverse deleted)) 259 | (cons 'activated (nreverse activated)) 260 | (cons 'error (nreverse errored))))) 261 | 262 | (defvar paradox--current-filter) 263 | 264 | (declare-function async-inject-variables "async") 265 | (defun paradox--menu-execute-1 (&optional noquery) 266 | "Implementation used by `paradox-menu-execute'. 267 | NOQUERY, if non-nil, means to execute without prompting the 268 | user." 269 | (let ((before-alist (paradox--repo-alist)) 270 | install-list delete-list) 271 | (save-excursion 272 | (goto-char (point-min)) 273 | (let ((p (point)) 274 | (inhibit-read-only t)) 275 | (while (not (eobp)) 276 | (let ((c (char-after))) 277 | (if (eq c ?\s) 278 | (forward-line 1) 279 | (push (tabulated-list-get-id) 280 | (pcase c 281 | (`?D delete-list) 282 | (`?I install-list))) 283 | (delete-region p (point)) 284 | (forward-line 1) 285 | (setq p (point))))) 286 | (when (or delete-list install-list) 287 | (delete-region p (point)) 288 | (ignore-errors 289 | (set-window-start (selected-window) (point-min)))))) 290 | (if (not (or delete-list install-list)) 291 | (message "No operations specified.") 292 | ;; Confirm with the user. 293 | (when (or noquery 294 | (y-or-n-p (paradox--format-message 'question install-list delete-list))) 295 | ;; On Emacs 25, update the selected packages list. 296 | (when (fboundp 'package--update-selected-packages) 297 | (let-alist (package-menu--partition-transaction install-list delete-list) 298 | (package--update-selected-packages .install .delete))) 299 | ;; Background or foreground? 300 | (if (or (not install-list) 301 | (not (pcase paradox-execute-asynchronously 302 | (`nil nil) 303 | (`ask 304 | (if noquery nil 305 | (y-or-n-p "Execute in the background (see `paradox-execute-asynchronously')? "))) 306 | (_ t)))) 307 | ;; Synchronous execution 308 | (progn 309 | (let ((alist (paradox--perform-package-transaction install-list delete-list))) 310 | (run-hook-with-args 'paradox-after-execute-functions 311 | `((noquery . ,noquery) (async . nil) ,@alist))) 312 | (when (and (stringp paradox-github-token) paradox-automatically-star) 313 | (paradox--post-execute-star-unstar before-alist (paradox--repo-alist)))) 314 | ;; Start spinning 315 | (paradox--start-spinner) 316 | 317 | ;; Async execution 318 | (unless (require 'async nil t) 319 | (error "For asynchronous execution please install the `async' package")) 320 | ;; We have to do this with eval, because `async-start' is a 321 | ;; macro and it might not have been defined at compile-time. 322 | (eval 323 | `(async-start 324 | (lambda () 325 | (require 'package) 326 | ,(async-inject-variables "\\`package-") 327 | (setq package-menu-async nil) 328 | (dolist (elt package-alist) 329 | (package-activate (car elt) 'force)) 330 | (let ((alist ,(macroexpand 331 | `(paradox--perform-package-transaction ',install-list ',delete-list)))) 332 | (list package-alist 333 | (when (boundp 'package-selected-packages) 334 | package-selected-packages) 335 | package-archive-contents 336 | ;; This is the alist that will be passed to the hook. 337 | (cons '(noquery . ,noquery) (cons '(async . t) alist))))) 338 | (lambda (x) 339 | (setq package-alist (pop x) 340 | package-selected-packages (pop x) 341 | package-archive-contents (pop x)) 342 | (when (spinner-p paradox--spinner) 343 | (spinner-stop paradox--spinner) 344 | (setq paradox--spinner nil)) 345 | (setq paradox--executing nil) 346 | (run-hook-with-args 'paradox-after-execute-functions (pop x)) 347 | (paradox--post-execute-star-unstar ',before-alist (paradox--repo-alist)))))))))) 348 | 349 | 350 | ;;; Aux functions 351 | (defun paradox--repo-alist () 352 | "List of known repos." 353 | (delete-dups 354 | (remove nil 355 | (mapcar 356 | (lambda (it) (gethash it paradox--package-repo-list)) 357 | package-alist)))) 358 | 359 | (defun paradox--format-message (question-p install-list delete-list) 360 | "Format a message regarding a transaction. 361 | If QUESTION-P is non-nil, format a question suitable for 362 | `y-or-n-p', otherwise format a report in the past sense. 363 | INSTALL-LIST and DELETE-LIST are a list of packages about to be 364 | installed and deleted, respectively." 365 | (concat 366 | (when install-list 367 | (let ((len (length install-list))) 368 | (format "Install%s %d package%s" 369 | (if question-p "" "ed") 370 | len 371 | (if (> len 1) "s" "")))) 372 | (when (and install-list (not delete-list)) 373 | (if question-p "? " ".")) 374 | (when (and install-list delete-list) 375 | ", and ") 376 | (when delete-list 377 | (let ((len (length delete-list))) 378 | (format "Delete%s %d package%s%s" 379 | (if question-p "" "d") 380 | len 381 | (if (> len 1) "s" "") 382 | (if question-p "? " ".")))))) 383 | 384 | (defun paradox--post-execute-star-unstar (before after) 385 | "Star repos in AFTER absent from BEFORE, unstar vice-versa." 386 | (let ((repos (hash-table-keys paradox--user-starred-repos))) 387 | (mapc #'paradox--star-repo 388 | (seq-difference (seq-difference after before) repos)) 389 | (mapc #'paradox--unstar-repo 390 | (seq-intersection (seq-difference before after) repos)))) 391 | 392 | (provide 'paradox-execute) 393 | ;;; paradox-execute.el ends here 394 | -------------------------------------------------------------------------------- /paradox-github.el: -------------------------------------------------------------------------------- 1 | ;;; paradox-github.el --- interacting with the Github API -*- lexical-binding:t -*- 2 | 3 | ;; Copyright (C) 2014-2015 Artur Malabarba 4 | 5 | ;; Author: Artur Malabarba 6 | ;; Prefix: paradox 7 | ;; Separator: - 8 | 9 | ;;; License: 10 | ;; 11 | ;; This file is NOT part of GNU Emacs. 12 | ;; 13 | ;; This program is free software; you can redistribute it and/or 14 | ;; modify it under the terms of the GNU General Public License 15 | ;; as published by the Free Software Foundation; either version 2 16 | ;; of the License, or (at your option) any later version. 17 | ;; 18 | ;; This program is distributed in the hope that it will be useful, 19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 21 | ;; GNU General Public License for more details. 22 | ;; 23 | 24 | 25 | ;;; Code: 26 | (require 'cl-lib) 27 | (require 'package) 28 | (require 'paradox-core) 29 | 30 | (defgroup paradox-github nil 31 | "Paradox Github configurations." 32 | :prefix "paradox-" 33 | :package-version '(paradox . "2.0") 34 | :group 'paradox) 35 | 36 | (defvar paradox--user-starred-list nil) 37 | (make-obsolete-variable 38 | 'paradox--user-starred-list 'paradox--user-starred-repos "2.1") 39 | (defvar paradox--user-starred-repos (make-hash-table)) 40 | 41 | 42 | ;;; Github token 43 | (defcustom paradox-github-token nil 44 | "Access token to use for github actions. 45 | Currently, that means (un)starring repos. 46 | 47 | To generate an access token: 48 | 1. Visit the page https://github.com/settings/tokens/new?scopes=public_repo&description=Paradox 49 | and login to github (if asked). 50 | 2. Click on \"Generate Token\", copy the generated token, and 51 | save it to this variable by writing 52 | (setq paradox-github-token TOKEN) 53 | somewhere in your configuration and evaluating it (or just 54 | restart emacs). 55 | 56 | This is similar to how erc or jabber handle authentication in 57 | emacs, but the following disclaimer always worth reminding. 58 | 59 | DISCLAIMER 60 | When you save this variable, DON'T WRITE IT ANYWHERE PUBLIC. This 61 | token grants (very) limited access to your account. 62 | END DISCLAIMER 63 | 64 | One way to make this variable safer is to set it from your 65 | authinfo.gpg file. See this issue for instructions on how to do that: 66 | https://github.com/Malabarba/paradox/issues/147#issuecomment-409336111 67 | 68 | Paradox will ask you whether you want github integration the 69 | first time you start it. If you answer \"no\", it will remember 70 | your choice via `customize-save-variable'. You can do this 71 | manually by setting this variable to t. Setting it to nil means 72 | it hasn't been configured yet." 73 | :type '(choice (string :tag "Token") 74 | (const :tag "Disable" t) 75 | (const :tag "Ask me next time" nil)) 76 | :group 'paradox-github 77 | :package-version '(paradox . "0.2")) 78 | 79 | (defcustom paradox-automatically-star 'unconfigured 80 | "When you install new packages, should they be automatically starred? 81 | This variable has no effect if `paradox-github-token' isn't set 82 | to a string. 83 | 84 | Paradox is capable of automatically starring packages when you 85 | install them, and unstarring when you delete them. This only 86 | applies to actual installation/deletion, i.e. Paradox doesn't 87 | auto (un)star packages that were simply upgraded. 88 | 89 | If this variable is nil, this behaviour is disabled. \\ 90 | 91 | On the Package Menu, you can always manually star packages with \\[paradox-menu-mark-star-unstar]." 92 | :type '(choice (const :tag "Yes" t) 93 | (const :tag "No" nil) 94 | (const :tag "Ask later" unconfigured)) 95 | :group 'paradox-github 96 | :package-version '(paradox . "0.2")) 97 | 98 | (defmacro paradox--enforce-github-token (&rest forms) 99 | "If a token is defined, perform FORMS, otherwise ignore forms ask for it be defined." 100 | `(if (stringp paradox-github-token) 101 | (progn ,@forms) 102 | (setq paradox-github-token nil) 103 | (paradox--check-github-token))) 104 | 105 | (defun paradox--check-github-token () 106 | "Check that the user has either set or refused the github token. 107 | If neither has happened, ask the user now whether he'd like to 108 | configure or refuse the token." 109 | (if (stringp paradox-github-token) t 110 | (if paradox-github-token 111 | t 112 | (if (not (y-or-n-p "Would you like to set up GitHub integration? 113 | This will allow you to star/unstar packages from the Package Menu. ")) 114 | (customize-save-variable 'paradox-github-token t) 115 | (describe-variable 'paradox-github-token) 116 | (when (get-buffer "*Help*") 117 | (switch-to-buffer "*Help*") 118 | (delete-other-windows)) 119 | (if (y-or-n-p "Follow the instructions on the `paradox-github-token' variable. 120 | May I take you to the token generation page? ") 121 | (browse-url "https://github.com/settings/tokens/new?scopes=public_repo&description=Paradox")) 122 | (message "Once you're finished, simply call `paradox-list-packages' again.") 123 | nil)))) 124 | 125 | 126 | ;;; Starring 127 | (defun paradox-star-all-installed-packages () 128 | "Star all of your currently installed packages. 129 | No questions asked." 130 | (interactive) 131 | (paradox--enforce-github-token 132 | (mapc (lambda (x) (paradox--star-package-safe (car-safe x))) package-alist))) 133 | 134 | (defun paradox--starred-repo-p (repo) 135 | "Non-nil if REPO is starred by the user." 136 | (gethash repo paradox--user-starred-repos)) 137 | 138 | (defun paradox--star-package-safe (pkg &optional delete query) 139 | "Star PKG without throwing errors, unless DELETE is non-nil, then unstar. 140 | If QUERY is non-nil, ask the user first." 141 | (let ((repo (gethash pkg paradox--package-repo-list))) 142 | (when (and repo (paradox--starred-repo-p repo)) 143 | (paradox--star-repo repo delete query)))) 144 | 145 | (defun paradox--star-repo (repo &optional delete query) 146 | "Star REPO, unless DELETE is non-nil, then unstar. 147 | If QUERY is non-nil, ask the user first. 148 | 149 | Throws error if repo is malformed." 150 | (when (or (not query) 151 | (y-or-n-p (format "Really %sstar %s? " 152 | (if delete "un" "") repo))) 153 | (paradox--github-action-star repo delete) 154 | (message "%starred %s." (if delete "Uns" "S") repo) 155 | (if delete 156 | (remhash repo paradox--user-starred-repos) 157 | (puthash repo t paradox--user-starred-repos)))) 158 | 159 | (defun paradox--unstar-repo (repo &optional delete query) 160 | "Unstar REPO. 161 | Calls (paradox--star-repo REPO (not DELETE) QUERY)." 162 | (paradox--star-repo repo (not delete) query)) 163 | 164 | (defun paradox--full-name-reader () 165 | "Return all \"full_name\" properties in the buffer. 166 | Much faster than `json-read'." 167 | (let (out) 168 | (while (search-forward-regexp 169 | "^ *\"full_name\" *: *\"\\(.*\\)\", *$" nil t) 170 | (push (match-string-no-properties 1) out)) 171 | (goto-char (point-max)) 172 | out)) 173 | 174 | (defun paradox--refresh-user-starred-list (&optional async) 175 | "Fetch the user's list of starred repos." 176 | (paradox--github-action "user/starred?per_page=100" 177 | :async (when async 'refresh) 178 | :callback (lambda (res) 179 | (setq paradox--user-starred-repos 180 | (make-hash-table :size (length res) 181 | :test #'equal)) 182 | (dolist (it res) 183 | (puthash it t paradox--user-starred-repos))) 184 | :reader #'paradox--full-name-reader)) 185 | 186 | (defun paradox--github-action-star (repo &optional delete) 187 | "Call `paradox--github-action' with \"user/starred/REPO\" as the action. 188 | DELETE and NO-RESULT are passed on." 189 | (paradox--github-action (concat "user/starred/" repo) 190 | :async t 191 | :method (if (stringp delete) delete 192 | (if delete "DELETE" "PUT")))) 193 | 194 | 195 | ;;; The Base (generic) function 196 | (defun paradox--github-report (&rest text) 197 | "Write TEXT to the *Paradox Github* buffer." 198 | (with-current-buffer (get-buffer-create "*Paradox Report*") 199 | (let ((inhibit-read-only t)) 200 | (erase-buffer) 201 | (apply #'insert text)) 202 | (goto-char (point-min)))) 203 | 204 | (defun paradox--github-error (format &rest args) 205 | "Throw an error using FORMAT and ARGS. 206 | Also print contents of current buffer to *Paradox Github*." 207 | (declare (indent 1)) 208 | (paradox--github-report (buffer-string)) 209 | (apply #'error 210 | (concat format " See *Paradox Github* buffer for the full result") 211 | args)) 212 | 213 | (defvar paradox--github-errors-to-ignore nil 214 | "List of numbers to ignore when parsing the HTML return code. 215 | `paradox--github-parse-response-code' normally returns nil on 216 | 200, t on 204, and emits messages or errors on other values. 217 | Adding values to this list makes them be treated as a 200.") 218 | 219 | (defun paradox--github-parse-response-code () 220 | "Non-nil if this reponse buffer looks ok. 221 | Leave point at the return code on the first line." 222 | (goto-char (point-min)) 223 | (unless (search-forward " " nil t) 224 | (paradox--github-report (buffer-string)) 225 | (error "Tried contacting Github, but I can't understand the result. See *Paradox Github* buffer for the full result")) 226 | (pcase (thing-at-point 'number) 227 | ((pred (lambda (n) (member n paradox--github-errors-to-ignore))) nil) 228 | (`204 nil) ;; OK, but no content. 229 | (`200 t) ;; OK, with content. 230 | ;; I'll implement redirection if anyone ever reports this. 231 | ;; For now, I haven't found a place where it's used. 232 | ((or `301 `302 `303 `304 `305 `306 `307) 233 | (paradox--github-report "Redirect received:\n\n" (buffer-string)) 234 | ;; (message "Received a redirect reply, please file a bug report (M-x `paradox-bug-report')") 235 | nil) 236 | ((or `404) ;; Not found. 237 | (paradox--github-report (buffer-string)) 238 | (message "This repo doesn't seem to exist, Github replied with: %s" 239 | (substring (thing-at-point 'line) 0 -1)) 240 | nil) 241 | ((or `403) ;; Forbidden 242 | (paradox--github-error 243 | "Github wouldn't let me do this - does your token have the right permissions? They're here: https://github.com/settings/tokens")) 244 | ((or `400 `422) ;; Bad request. 245 | (paradox--github-error 246 | "Github didn't understand my request, please file a bug report (M-x `paradox-bug-report')")) 247 | (`401 (paradox--github-error 248 | (if (stringp paradox-github-token) 249 | "Github says you're not authenticated, try creating a new Github token" 250 | "Github says you're not authenticated, you need to configure `paradox-github-token'"))) 251 | (_ (paradox--github-error "Github returned: %S" 252 | (substring (thing-at-point 'line) 0 -1))))) 253 | 254 | (defvar paradox--github-next-page nil) 255 | 256 | (defun paradox--https-proxy () 257 | "Get https proxy if url-proxy-services has been defined." 258 | (if (and (boundp 'url-proxy-services) 259 | (assoc "https" url-proxy-services)) 260 | (cdr (assoc "https" url-proxy-services)) 261 | "")) 262 | 263 | (defmacro paradox--with-github-buffer (method action async unwind-form 264 | &rest body) 265 | "Run BODY in a Github request buffer. 266 | UNWIND-FORM is run no matter what, and doesn't affect the return 267 | value." 268 | (declare (indent 4) 269 | (debug t)) 270 | (let ((call-name (make-symbol "callback"))) 271 | `(let ((,call-name 272 | (lambda (&optional process event) 273 | (cond 274 | ((or (not event) 275 | (string-match "\\`finished" event)) 276 | (with-current-buffer (if (processp process) 277 | (process-buffer process) 278 | (current-buffer)) 279 | (unwind-protect 280 | (when (paradox--github-parse-response-code) 281 | (let ((next-page)) 282 | (when (search-forward-regexp 283 | "^Link: .*<\\([^>]+\\)>; rel=\"next\"" nil t) 284 | (setq next-page (match-string-no-properties 1)) 285 | (setq paradox--github-next-page next-page)) 286 | (ignore next-page) 287 | (search-forward-regexp "^\r?$") 288 | (skip-chars-forward "[:blank:]\n\r") 289 | (delete-region (point-min) (point)) 290 | ,@body)) 291 | ,unwind-form 292 | (kill-buffer (current-buffer))))) 293 | ((string-match "\\`exited abnormally" event) 294 | ,unwind-form 295 | (paradox--github-report (buffer-string)) 296 | (message "async curl command %s\n method: %s\n action: %s" 297 | event ,method ,action)))))) 298 | (if ,async 299 | (condition-case nil 300 | (set-process-sentinel 301 | (apply #'start-process "paradox-github" 302 | (generate-new-buffer "*Paradox http*") 303 | "curl" 304 | "-x" (paradox-https-proxy) 305 | "-s" "-i" "-d" "" "-X" ,method ,action 306 | (when (stringp paradox-github-token) 307 | (list "-u" (concat paradox-github-token ":x-oauth-basic")))) 308 | ,call-name) 309 | (error ,unwind-form)) 310 | (with-temp-buffer 311 | ;; Make the request. 312 | (condition-case nil 313 | (apply #'call-process 314 | "curl" nil t nil 315 | "-x" (paradox--https-proxy) 316 | "-s" "-i" "-d" "" "-X" ,method ,action 317 | (when (stringp paradox-github-token) 318 | (list "-u" (concat paradox-github-token ":x-oauth-basic")))) 319 | (error ,unwind-form)) 320 | ;; Do the processing. 321 | (funcall ,call-name)))))) 322 | 323 | (cl-defun paradox--github-action (action &key 324 | (method "GET") 325 | reader 326 | max-pages 327 | (callback #'identity) 328 | async) 329 | "Contact the github api performing ACTION with METHOD. 330 | Default METHOD is \"GET\". 331 | 332 | Action can be anything such as \"user/starred?per_page=100\". If 333 | it's not a full url, it will be prepended with 334 | \"https://api.github.com/\". The action might not work if 335 | `paradox-github-token' isn't set. 336 | 337 | This function also handles the pagination used in github results, 338 | results of each page are appended together. Use MAX-PAGES to 339 | limit the number of pages that are fetched. 340 | 341 | Return value is always a list. 342 | - If READER is nil, the result of the action is completely 343 | ignored (no pagination is performed on this case, making it 344 | much faster). 345 | - Otherwise, READER is called as a function with point right 346 | after the headers and should always return a list. As a special 347 | exception, if READER is t, it is equivalent to a function that 348 | returns (t). 349 | 350 | CALLBACK, if provided, is a function to be called with the read 351 | data as an argument. If the request succeeds with no data, it 352 | will be given nil as an argument. Its return value is returned by 353 | this function. 354 | 355 | ASYNC determines to run the command asynchronously. In this case, 356 | the function's return value is undefined. In particular, if ASYNC 357 | is the symbol refresh, it means the package-menu should be 358 | refreshed after the operation is done." 359 | (declare (indent 1)) 360 | ;; Make sure the token's configured. 361 | (unless (string-match "\\`https?://" action) 362 | (setq action (concat "https://api.github.com/" action))) 363 | (let ((do-update (when (eq async 'refresh) 364 | (make-symbol "paradox-github")))) 365 | (when do-update 366 | (add-to-list 'package--downloads-in-progress do-update)) 367 | (paradox--with-github-buffer method action async 368 | (paradox--update-downloads-in-progress 369 | do-update) 370 | (cond 371 | ((not reader) 372 | (funcall callback nil)) 373 | ((or (not next-page) 374 | (and max-pages (< max-pages 2))) 375 | (funcall callback 376 | (unless (eobp) (funcall reader)))) 377 | (t 378 | (let ((result (unless (eobp) (funcall reader)))) 379 | (paradox--github-action next-page 380 | :method method 381 | :reader reader 382 | :async async 383 | :max-pages (when max-pages (1- max-pages)) 384 | :callback (lambda (res) 385 | (funcall callback 386 | (append result res)))))))))) 387 | 388 | (provide 'paradox-github) 389 | ;;; paradox-github.el ends here 390 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 2, June 1991 3 | 4 | Copyright (C) 1989, 1991 Free Software Foundation, Inc., 5 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 6 | Everyone is permitted to copy and distribute verbatim copies 7 | of this license document, but changing it is not allowed. 8 | 9 | Preamble 10 | 11 | The licenses for most software are designed to take away your 12 | freedom to share and change it. By contrast, the GNU General Public 13 | License is intended to guarantee your freedom to share and change free 14 | software--to make sure the software is free for all its users. This 15 | General Public License applies to most of the Free Software 16 | Foundation's software and to any other program whose authors commit to 17 | using it. (Some other Free Software Foundation software is covered by 18 | the GNU Lesser General Public License instead.) You can apply it to 19 | your programs, too. 20 | 21 | When we speak of free software, we are referring to freedom, not 22 | price. Our General Public Licenses are designed to make sure that you 23 | have the freedom to distribute copies of free software (and charge for 24 | this service if you wish), that you receive source code or can get it 25 | if you want it, that you can change the software or use pieces of it 26 | in new free programs; and that you know you can do these things. 27 | 28 | To protect your rights, we need to make restrictions that forbid 29 | anyone to deny you these rights or to ask you to surrender the rights. 30 | These restrictions translate to certain responsibilities for you if you 31 | distribute copies of the software, or if you modify it. 32 | 33 | For example, if you distribute copies of such a program, whether 34 | gratis or for a fee, you must give the recipients all the rights that 35 | you have. You must make sure that they, too, receive or can get the 36 | source code. And you must show them these terms so they know their 37 | rights. 38 | 39 | We protect your rights with two steps: (1) copyright the software, and 40 | (2) offer you this license which gives you legal permission to copy, 41 | distribute and/or modify the software. 42 | 43 | Also, for each author's protection and ours, we want to make certain 44 | that everyone understands that there is no warranty for this free 45 | software. If the software is modified by someone else and passed on, we 46 | want its recipients to know that what they have is not the original, so 47 | that any problems introduced by others will not reflect on the original 48 | authors' reputations. 49 | 50 | Finally, any free program is threatened constantly by software 51 | patents. We wish to avoid the danger that redistributors of a free 52 | program will individually obtain patent licenses, in effect making the 53 | program proprietary. To prevent this, we have made it clear that any 54 | patent must be licensed for everyone's free use or not licensed at all. 55 | 56 | The precise terms and conditions for copying, distribution and 57 | modification follow. 58 | 59 | GNU GENERAL PUBLIC LICENSE 60 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 61 | 62 | 0. This License applies to any program or other work which contains 63 | a notice placed by the copyright holder saying it may be distributed 64 | under the terms of this General Public License. The "Program", below, 65 | refers to any such program or work, and a "work based on the Program" 66 | means either the Program or any derivative work under copyright law: 67 | that is to say, a work containing the Program or a portion of it, 68 | either verbatim or with modifications and/or translated into another 69 | language. (Hereinafter, translation is included without limitation in 70 | the term "modification".) Each licensee is addressed as "you". 71 | 72 | Activities other than copying, distribution and modification are not 73 | covered by this License; they are outside its scope. The act of 74 | running the Program is not restricted, and the output from the Program 75 | is covered only if its contents constitute a work based on the 76 | Program (independent of having been made by running the Program). 77 | Whether that is true depends on what the Program does. 78 | 79 | 1. You may copy and distribute verbatim copies of the Program's 80 | source code as you receive it, in any medium, provided that you 81 | conspicuously and appropriately publish on each copy an appropriate 82 | copyright notice and disclaimer of warranty; keep intact all the 83 | notices that refer to this License and to the absence of any warranty; 84 | and give any other recipients of the Program a copy of this License 85 | along with the Program. 86 | 87 | You may charge a fee for the physical act of transferring a copy, and 88 | you may at your option offer warranty protection in exchange for a fee. 89 | 90 | 2. You may modify your copy or copies of the Program or any portion 91 | of it, thus forming a work based on the Program, and copy and 92 | distribute such modifications or work under the terms of Section 1 93 | above, provided that you also meet all of these conditions: 94 | 95 | a) You must cause the modified files to carry prominent notices 96 | stating that you changed the files and the date of any change. 97 | 98 | b) You must cause any work that you distribute or publish, that in 99 | whole or in part contains or is derived from the Program or any 100 | part thereof, to be licensed as a whole at no charge to all third 101 | parties under the terms of this License. 102 | 103 | c) If the modified program normally reads commands interactively 104 | when run, you must cause it, when started running for such 105 | interactive use in the most ordinary way, to print or display an 106 | announcement including an appropriate copyright notice and a 107 | notice that there is no warranty (or else, saying that you provide 108 | a warranty) and that users may redistribute the program under 109 | these conditions, and telling the user how to view a copy of this 110 | License. (Exception: if the Program itself is interactive but 111 | does not normally print such an announcement, your work based on 112 | the Program is not required to print an announcement.) 113 | 114 | These requirements apply to the modified work as a whole. If 115 | identifiable sections of that work are not derived from the Program, 116 | and can be reasonably considered independent and separate works in 117 | themselves, then this License, and its terms, do not apply to those 118 | sections when you distribute them as separate works. But when you 119 | distribute the same sections as part of a whole which is a work based 120 | on the Program, the distribution of the whole must be on the terms of 121 | this License, whose permissions for other licensees extend to the 122 | entire whole, and thus to each and every part regardless of who wrote it. 123 | 124 | Thus, it is not the intent of this section to claim rights or contest 125 | your rights to work written entirely by you; rather, the intent is to 126 | exercise the right to control the distribution of derivative or 127 | collective works based on the Program. 128 | 129 | In addition, mere aggregation of another work not based on the Program 130 | with the Program (or with a work based on the Program) on a volume of 131 | a storage or distribution medium does not bring the other work under 132 | the scope of this License. 133 | 134 | 3. You may copy and distribute the Program (or a work based on it, 135 | under Section 2) in object code or executable form under the terms of 136 | Sections 1 and 2 above provided that you also do one of the following: 137 | 138 | a) Accompany it with the complete corresponding machine-readable 139 | source code, which must be distributed under the terms of Sections 140 | 1 and 2 above on a medium customarily used for software interchange; or, 141 | 142 | b) Accompany it with a written offer, valid for at least three 143 | years, to give any third party, for a charge no more than your 144 | cost of physically performing source distribution, a complete 145 | machine-readable copy of the corresponding source code, to be 146 | distributed under the terms of Sections 1 and 2 above on a medium 147 | customarily used for software interchange; or, 148 | 149 | c) Accompany it with the information you received as to the offer 150 | to distribute corresponding source code. (This alternative is 151 | allowed only for noncommercial distribution and only if you 152 | received the program in object code or executable form with such 153 | an offer, in accord with Subsection b above.) 154 | 155 | The source code for a work means the preferred form of the work for 156 | making modifications to it. For an executable work, complete source 157 | code means all the source code for all modules it contains, plus any 158 | associated interface definition files, plus the scripts used to 159 | control compilation and installation of the executable. However, as a 160 | special exception, the source code distributed need not include 161 | anything that is normally distributed (in either source or binary 162 | form) with the major components (compiler, kernel, and so on) of the 163 | operating system on which the executable runs, unless that component 164 | itself accompanies the executable. 165 | 166 | If distribution of executable or object code is made by offering 167 | access to copy from a designated place, then offering equivalent 168 | access to copy the source code from the same place counts as 169 | distribution of the source code, even though third parties are not 170 | compelled to copy the source along with the object code. 171 | 172 | 4. You may not copy, modify, sublicense, or distribute the Program 173 | except as expressly provided under this License. Any attempt 174 | otherwise to copy, modify, sublicense or distribute the Program is 175 | void, and will automatically terminate your rights under this License. 176 | However, parties who have received copies, or rights, from you under 177 | this License will not have their licenses terminated so long as such 178 | parties remain in full compliance. 179 | 180 | 5. You are not required to accept this License, since you have not 181 | signed it. However, nothing else grants you permission to modify or 182 | distribute the Program or its derivative works. These actions are 183 | prohibited by law if you do not accept this License. Therefore, by 184 | modifying or distributing the Program (or any work based on the 185 | Program), you indicate your acceptance of this License to do so, and 186 | all its terms and conditions for copying, distributing or modifying 187 | the Program or works based on it. 188 | 189 | 6. Each time you redistribute the Program (or any work based on the 190 | Program), the recipient automatically receives a license from the 191 | original licensor to copy, distribute or modify the Program subject to 192 | these terms and conditions. You may not impose any further 193 | restrictions on the recipients' exercise of the rights granted herein. 194 | You are not responsible for enforcing compliance by third parties to 195 | this License. 196 | 197 | 7. If, as a consequence of a court judgment or allegation of patent 198 | infringement or for any other reason (not limited to patent issues), 199 | conditions are imposed on you (whether by court order, agreement or 200 | otherwise) that contradict the conditions of this License, they do not 201 | excuse you from the conditions of this License. If you cannot 202 | distribute so as to satisfy simultaneously your obligations under this 203 | License and any other pertinent obligations, then as a consequence you 204 | may not distribute the Program at all. For example, if a patent 205 | license would not permit royalty-free redistribution of the Program by 206 | all those who receive copies directly or indirectly through you, then 207 | the only way you could satisfy both it and this License would be to 208 | refrain entirely from distribution of the Program. 209 | 210 | If any portion of this section is held invalid or unenforceable under 211 | any particular circumstance, the balance of the section is intended to 212 | apply and the section as a whole is intended to apply in other 213 | circumstances. 214 | 215 | It is not the purpose of this section to induce you to infringe any 216 | patents or other property right claims or to contest validity of any 217 | such claims; this section has the sole purpose of protecting the 218 | integrity of the free software distribution system, which is 219 | implemented by public license practices. Many people have made 220 | generous contributions to the wide range of software distributed 221 | through that system in reliance on consistent application of that 222 | system; it is up to the author/donor to decide if he or she is willing 223 | to distribute software through any other system and a licensee cannot 224 | impose that choice. 225 | 226 | This section is intended to make thoroughly clear what is believed to 227 | be a consequence of the rest of this License. 228 | 229 | 8. If the distribution and/or use of the Program is restricted in 230 | certain countries either by patents or by copyrighted interfaces, the 231 | original copyright holder who places the Program under this License 232 | may add an explicit geographical distribution limitation excluding 233 | those countries, so that distribution is permitted only in or among 234 | countries not thus excluded. In such case, this License incorporates 235 | the limitation as if written in the body of this License. 236 | 237 | 9. The Free Software Foundation may publish revised and/or new versions 238 | of the General Public License from time to time. Such new versions will 239 | be similar in spirit to the present version, but may differ in detail to 240 | address new problems or concerns. 241 | 242 | Each version is given a distinguishing version number. If the Program 243 | specifies a version number of this License which applies to it and "any 244 | later version", you have the option of following the terms and conditions 245 | either of that version or of any later version published by the Free 246 | Software Foundation. If the Program does not specify a version number of 247 | this License, you may choose any version ever published by the Free Software 248 | Foundation. 249 | 250 | 10. If you wish to incorporate parts of the Program into other free 251 | programs whose distribution conditions are different, write to the author 252 | to ask for permission. For software which is copyrighted by the Free 253 | Software Foundation, write to the Free Software Foundation; we sometimes 254 | make exceptions for this. Our decision will be guided by the two goals 255 | of preserving the free status of all derivatives of our free software and 256 | of promoting the sharing and reuse of software generally. 257 | 258 | NO WARRANTY 259 | 260 | 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY 261 | FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN 262 | OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES 263 | PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED 264 | OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 265 | MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS 266 | TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE 267 | PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, 268 | REPAIR OR CORRECTION. 269 | 270 | 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 271 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR 272 | REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, 273 | INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING 274 | OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED 275 | TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY 276 | YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER 277 | PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE 278 | POSSIBILITY OF SUCH DAMAGES. 279 | 280 | END OF TERMS AND CONDITIONS 281 | 282 | How to Apply These Terms to Your New Programs 283 | 284 | If you develop a new program, and you want it to be of the greatest 285 | possible use to the public, the best way to achieve this is to make it 286 | free software which everyone can redistribute and change under these terms. 287 | 288 | To do so, attach the following notices to the program. It is safest 289 | to attach them to the start of each source file to most effectively 290 | convey the exclusion of warranty; and each file should have at least 291 | the "copyright" line and a pointer to where the full notice is found. 292 | 293 | {description} 294 | Copyright (C) {year} {fullname} 295 | 296 | This program is free software; you can redistribute it and/or modify 297 | it under the terms of the GNU General Public License as published by 298 | the Free Software Foundation; either version 2 of the License, or 299 | (at your option) any later version. 300 | 301 | This program is distributed in the hope that it will be useful, 302 | but WITHOUT ANY WARRANTY; without even the implied warranty of 303 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 304 | GNU General Public License for more details. 305 | 306 | You should have received a copy of the GNU General Public License along 307 | with this program; if not, write to the Free Software Foundation, Inc., 308 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 309 | 310 | Also add information on how to contact you by electronic and paper mail. 311 | 312 | If the program is interactive, make it output a short notice like this 313 | when it starts in an interactive mode: 314 | 315 | Gnomovision version 69, Copyright (C) year name of author 316 | Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 317 | This is free software, and you are welcome to redistribute it 318 | under certain conditions; type `show c' for details. 319 | 320 | The hypothetical commands `show w' and `show c' should show the appropriate 321 | parts of the General Public License. Of course, the commands you use may 322 | be called something other than `show w' and `show c'; they could even be 323 | mouse-clicks or menu items--whatever suits your program. 324 | 325 | You should also get your employer (if you work as a programmer) or your 326 | school, if any, to sign a "copyright disclaimer" for the program, if 327 | necessary. Here is a sample; alter the names: 328 | 329 | Yoyodyne, Inc., hereby disclaims all copyright interest in the program 330 | `Gnomovision' (which makes passes at compilers) written by James Hacker. 331 | 332 | {signature of Ty Coon}, 1 April 1989 333 | Ty Coon, President of Vice 334 | 335 | This General Public License does not permit incorporating your program into 336 | proprietary programs. If your program is a subroutine library, you may 337 | consider it more useful to permit linking proprietary applications with the 338 | library. If this is what you want to do, use the GNU Lesser General 339 | Public License instead of this License. -------------------------------------------------------------------------------- /paradox-menu.el: -------------------------------------------------------------------------------- 1 | ;;; paradox-menu.el --- defining the Packages menu -*- lexical-binding:t -*- 2 | 3 | ;; Copyright (C) 2014-2015 Artur Malabarba 4 | 5 | ;; Author: Artur Malabarba 6 | ;; Prefix: paradox 7 | ;; Separator: - 8 | 9 | ;;; License: 10 | ;; 11 | ;; This file is NOT part of GNU Emacs. 12 | ;; 13 | ;; This program is free software; you can redistribute it and/or 14 | ;; modify it under the terms of the GNU General Public License 15 | ;; as published by the Free Software Foundation; either version 2 16 | ;; of the License, or (at your option) any later version. 17 | ;; 18 | ;; This program is distributed in the hope that it will be useful, 19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 21 | ;; GNU General Public License for more details. 22 | ;; 23 | 24 | ;;; Code: 25 | (require 'cl-lib) 26 | (require 'cus-edit) 27 | (require 'package) 28 | (require 'subr-x) 29 | (require 'hydra) 30 | 31 | (require 'paradox-core) 32 | (require 'paradox-github) 33 | (require 'paradox-commit-list) 34 | (require 'paradox-execute) 35 | 36 | (defgroup paradox-menu nil 37 | "Paradox Packages Menu configurations." 38 | :prefix "paradox-" 39 | :package-version '(paradox . "2.0") 40 | :group 'paradox) 41 | 42 | 43 | ;;; Customization Variables 44 | (defcustom paradox-column-width-package 18 45 | "Width of the \"Package\" column." 46 | :type 'integer 47 | :group 'paradox-menu 48 | :package-version '(paradox . "0.1")) 49 | 50 | (defcustom paradox-column-width-version 9 51 | "Width of the \"Version\" column." 52 | :type 'integer 53 | :group 'paradox-menu 54 | :package-version '(paradox . "0.1")) 55 | 56 | (defcustom paradox-column-width-status 10 57 | "Width of the \"Status\" column." 58 | :type 'integer 59 | :group 'paradox-menu 60 | :package-version '(paradox . "0.1")) 61 | 62 | (defcustom paradox-column-width-star 4 63 | "Width of the \"Star\" column." 64 | :type 'integer 65 | :group 'paradox-menu 66 | :package-version '(paradox . "0.1")) 67 | 68 | (defcustom paradox-column-width-download 4 69 | "Width of the \"Download Count\" column." 70 | :type 'integer 71 | :group 'paradox-menu 72 | :package-version '(paradox . "1.1")) 73 | 74 | (defcustom paradox-display-star-count t 75 | "If non-nil, adds a \"Star\" column to the Package Menu." 76 | :type 'boolean 77 | :group 'paradox-menu 78 | :package-version '(paradox . "1.1")) 79 | 80 | (defcustom paradox-display-download-count nil 81 | "If non-nil, adds a \"Download\" column to the Package Menu." 82 | :type 'boolean 83 | :group 'paradox-menu 84 | :package-version '(paradox . "1.2.3")) 85 | 86 | (defface paradox-mode-line-face 87 | '((t :inherit (font-lock-keyword-face mode-line-buffer-id) 88 | :weight normal)) 89 | "Face used on mode line statuses." 90 | :group 'paradox) 91 | (defface paradox-name-face 92 | '((t :inherit link)) 93 | "Face used on the package's name." 94 | :group 'paradox) 95 | (defface paradox-homepage-button-face 96 | '((t :underline t :inherit font-lock-comment-face)) 97 | "Face used on the homepage button." 98 | :group 'paradox) 99 | ;; (defface paradox-version-face 100 | ;; '((t :inherit default)) 101 | ;; "Face used on the version column." 102 | ;; :group 'paradox) 103 | (defface paradox-archive-face 104 | '((t :inherit paradox-comment-face)) 105 | "Face used on the archive column." 106 | :group 'paradox) 107 | (defface paradox-star-face 108 | '((t :inherit font-lock-string-face)) 109 | "Face used on the star column, for packages you haven't starred." 110 | :group 'paradox) 111 | (defface paradox-starred-face 112 | '((t :inherit font-lock-variable-name-face)) 113 | "Face used on the star column, for packages you have starred." 114 | :group 'paradox) 115 | (defface paradox-download-face 116 | '((t :inherit font-lock-keyword-face)) 117 | "Face used on the Downloads column." 118 | :group 'paradox) 119 | (defface paradox-description-face 120 | '((t :inherit default)) 121 | "Face used on the description column. 122 | If `paradox-lines-per-entry' > 1, the face 123 | `paradox-description-face-multiline' is used instead." 124 | :group 'paradox) 125 | (defface paradox-description-face-multiline 126 | '((t :inherit font-lock-doc-face)) 127 | "Face used on the description column when `paradox-lines-per-entry' > 1. 128 | If `paradox-lines-per-entry' = 1, the face 129 | `paradox-description-face' is used instead." 130 | :group 'paradox) 131 | 132 | (defcustom paradox-status-face-alist 133 | '(("built-in" . font-lock-builtin-face) 134 | ("available" . default) 135 | ("new" . bold) 136 | ("held" . font-lock-constant-face) 137 | ("disabled" . font-lock-warning-face) 138 | ("avail-obso" . font-lock-comment-face) 139 | ("installed" . font-lock-comment-face) 140 | ("dependency" . font-lock-comment-face) 141 | ("incompat" . font-lock-comment-face) 142 | ("deleted" . font-lock-comment-face) 143 | ("unsigned" . font-lock-warning-face)) 144 | "List of (\"STATUS\" . FACE) cons cells. 145 | When displaying the package menu, FACE will be used to paint the 146 | Version, Status, and Description columns of each package whose 147 | status is STATUS." 148 | :type '(repeat (cons string face)) 149 | :group 'paradox-menu 150 | :package-version '(paradox . "2.0")) 151 | 152 | (defcustom paradox-homepage-button-string "h" 153 | "String used to for the link that takes you to a package's homepage." 154 | :type 'string 155 | :group 'paradox-menu 156 | :package-version '(paradox . "0.10")) 157 | 158 | (defcustom paradox-use-homepage-buttons t 159 | "If non-nil a button will be added after the name of each package. 160 | This button takes you to the package's homepage." 161 | :type 'boolean 162 | :group 'paradox-menu 163 | :package-version '(paradox . "0.10")) 164 | 165 | (defcustom paradox-lines-per-entry 1 166 | "Number of lines used to display each entry in the Package Menu. 167 | 1 Gives you the regular package menu. 168 | 2 Displays the description on a separate line below the entry. 169 | 3+ Adds empty lines separating the entries." 170 | :type 'integer 171 | :group 'paradox-menu 172 | :package-version '(paradox . "0.10")) 173 | 174 | 175 | ;;; Internal 176 | (defvar-local paradox--current-filter nil) 177 | 178 | (defvar paradox--column-name-star 179 | (if (char-displayable-p ?\x2605) "\x2605" "*")) 180 | 181 | (defvar paradox--column-name-download 182 | (if (char-displayable-p ?\x2193) "\x2193" "DC")) 183 | 184 | (defvar paradox--upgradeable-packages nil) 185 | (defvar paradox--upgradeable-packages-number nil) 186 | (defvar paradox--upgradeable-packages-any? nil) 187 | 188 | (defvar paradox--column-index-star nil) 189 | (defvar paradox--column-index-download nil) 190 | 191 | (defvar paradox--desc-suffix nil) 192 | (defvar paradox--desc-prefix nil) 193 | 194 | (defvar paradox--commit-list-buffer "*Package Commit List*") 195 | 196 | (define-button-type 'paradox-name 197 | 'action #'package-menu-describe-package 198 | 'follow-link t) 199 | 200 | (define-button-type 'paradox-homepage 201 | 'action #'paradox-menu-visit-homepage 202 | 'follow-link t 203 | 'mouse-face 'custom-button-mouse) 204 | 205 | ;; Use `font-lock-face' on creation instead. 206 | (button-type-put 'paradox-name 'face nil) 207 | (button-type-put 'paradox-homepage 'face nil) 208 | 209 | 210 | ;;; Building the packages buffer. 211 | (defun paradox-refresh-upgradeable-packages () 212 | "Refresh the list of upgradeable packages." 213 | (interactive) 214 | (setq paradox--upgradeable-packages (package-menu--find-upgrades)) 215 | (setq paradox--upgradeable-packages-number 216 | (length paradox--upgradeable-packages)) 217 | (setq paradox--upgradeable-packages-any? 218 | (> paradox--upgradeable-packages-number 0))) 219 | 220 | (defun paradox--print-info (pkg) 221 | "Return a package entry suitable for `tabulated-list-entries'. 222 | PKG has the form (PKG-DESC . STATUS). 223 | Return (PKG-DESC [STAR NAME VERSION STATUS DOC])." 224 | (let* ((pkg-desc (if (consp pkg) (car pkg) pkg)) 225 | (status (if (consp pkg) (cdr pkg) (package-desc-status pkg))) 226 | (face (or (cdr (assoc-string status paradox-status-face-alist)) 227 | 'font-lock-warning-face)) 228 | (url (paradox--package-homepage pkg-desc)) 229 | (name (symbol-name (package-desc-name pkg-desc))) 230 | (name-length (length name)) 231 | (counts (paradox--count-print (package-desc-name pkg-desc))) 232 | (button-length (if paradox-use-homepage-buttons (length paradox-homepage-button-string) 0))) 233 | (paradox--incf status) 234 | (let ((cell (assq :stars (package-desc-extras pkg-desc)))) 235 | (if cell 236 | (setcdr cell counts) 237 | (push (cons :stars counts) (package-desc-extras pkg-desc)))) 238 | (list pkg-desc 239 | `[,(concat 240 | (make-text-button 241 | (truncate-string-to-width 242 | name (- paradox-column-width-package button-length) 0 nil t) 243 | nil 244 | 'type 'paradox-name 245 | 'font-lock-face 'paradox-name-face 246 | 'help-echo (concat "Package: " name) 247 | 'package-desc pkg-desc) 248 | (when (and paradox-use-homepage-buttons url) 249 | (make-string (max 0 (- paradox-column-width-package name-length button-length)) ?\s)) 250 | (when (and paradox-use-homepage-buttons url) 251 | (make-text-button 252 | (copy-sequence paradox-homepage-button-string) nil 253 | 'type 'paradox-homepage 254 | 'font-lock-face 'paradox-homepage-button-face 255 | 'help-echo (format "Visit %s" url)))) 256 | ,(propertize (package-version-join 257 | (package-desc-version pkg-desc)) 258 | 'font-lock-face face) 259 | ,(propertize status 'font-lock-face face) 260 | ,@(if (cdr package-archives) 261 | (list (propertize (or (package-desc-archive pkg-desc) "") 262 | 'font-lock-face 'paradox-archive-face))) 263 | ,@counts 264 | ,(propertize 265 | (concat (propertize " " 'display paradox--desc-prefix) 266 | (package-desc-summary pkg-desc) 267 | (propertize " " 'display paradox--desc-suffix)) ;└╰ 268 | 'font-lock-face 269 | (if (> paradox-lines-per-entry 1) 270 | 'paradox-description-face-multiline 271 | 'paradox-description-face))]))) 272 | 273 | (defun paradox--count-print (pkg) 274 | "Return counts of PKG as a package-desc list." 275 | (append 276 | (when (and paradox-display-star-count (hash-table-p paradox--star-count)) 277 | (list (paradox--package-star-count pkg))) 278 | (when (and paradox-display-download-count (hash-table-p paradox--download-count)) 279 | (list (paradox--package-download-count pkg))))) 280 | 281 | (defun paradox--package-download-count (pkg) 282 | "Return propertized string with the download count of PKG." 283 | (let ((c (gethash pkg paradox--download-count nil))) 284 | (propertize 285 | (if (numberp c) 286 | (if (> c 999) (format "%sK" (truncate c 1000)) (format "%s" c)) 287 | " ") 288 | 'font-lock-face 'paradox-download-face 289 | 'value (or c 0)))) 290 | 291 | (defun paradox--package-homepage (pkg) 292 | "PKG can be the package-name symbol or a package-desc object." 293 | (let* ((object (if (symbolp pkg) (cadr (assoc pkg package-archive-contents)) pkg)) 294 | (name (if (symbolp pkg) pkg (package-desc-name pkg))) 295 | (extras (package-desc-extras object)) 296 | (homepage (and (listp extras) (cdr-safe (assoc :url extras))))) 297 | (or homepage 298 | (and (setq extras (gethash name paradox--package-repo-list)) 299 | (format "https://github.com/%s" extras))))) 300 | 301 | (defun paradox--get-or-return-package (pkg) 302 | "Take a marker or package name PKG and return a package name." 303 | (if (or (markerp pkg) (null pkg)) 304 | (if (derived-mode-p 'package-menu-mode) 305 | (package-desc-name (tabulated-list-get-id)) 306 | (error "Not in Package Menu")) 307 | pkg)) 308 | 309 | (defun paradox--incf (status) 310 | "Increment the count for STATUS on `paradox--package-count'. 311 | Also increments the count for \"total\"." 312 | (paradox--inc-count status) 313 | (unless (member status '("obsolete" "avail-obso" "incompat")) 314 | (paradox--inc-count "total"))) 315 | 316 | (defun paradox--inc-count (string) 317 | "Increment the cdr of (assoc-string STRING paradox--package-count)." 318 | (let ((cons (assoc-string string paradox--package-count))) 319 | (setcdr cons (1+ (cdr cons))))) 320 | 321 | (defun paradox--entry-star-count (entry) 322 | "Get the star count of the package in ENTRY." 323 | (paradox--package-star-count 324 | ;; The package symbol should be in the ID field, but that's not mandatory, 325 | (or (ignore-errors (elt (car entry) 1)) 326 | ;; So we also try interning the package name. 327 | (intern (car (elt (cadr entry) 0)))))) 328 | 329 | (defun paradox--handle-failed-download (&rest _) 330 | "Handle the case when Emacs fails to download Github data." 331 | (paradox--update-downloads-in-progress 'paradox--data) 332 | (unless (hash-table-p paradox--download-count) 333 | (setq paradox--download-count (make-hash-table))) 334 | (unless (hash-table-p paradox--package-repo-list) 335 | (setq paradox--package-repo-list (make-hash-table))) 336 | (unless (hash-table-p paradox--star-count) 337 | (setq paradox--star-count (make-hash-table))) 338 | (unless (hash-table-p paradox--wiki-packages) 339 | (setq paradox--wiki-packages (make-hash-table))) 340 | (message "[Paradox] Error downloading Github data")) 341 | 342 | (defmacro paradox--with-work-buffer (location file &rest body) 343 | "Run BODY in a buffer containing the contents of FILE at LOCATION. 344 | This is the same as `package--with-work-buffer-async', except it 345 | automatically decides whether to download asynchronously based on 346 | `package-menu-async'." 347 | (declare (indent 2) (debug t)) 348 | (require 'package) 349 | (if (fboundp 'package--with-response-buffer) 350 | `(package--with-response-buffer 351 | ,location :file ,file 352 | :async package-menu-async 353 | :error-form (paradox--handle-failed-download) 354 | ,@body 355 | (paradox--update-downloads-in-progress 'paradox--data)) 356 | `(package--with-work-buffer ,location ,file ,@body))) 357 | 358 | (defun paradox--refresh-remote-data () 359 | "Download metadata and populate the respective variables." 360 | (interactive) 361 | (when (boundp 'package--downloads-in-progress) 362 | (add-to-list 'package--downloads-in-progress 'paradox--data)) 363 | (condition-case-unless-debug nil 364 | (paradox--with-work-buffer paradox--data-url "data-hashtables" 365 | (setq paradox--star-count (read (current-buffer))) 366 | (setq paradox--package-repo-list (read (current-buffer))) 367 | (setq paradox--download-count (read (current-buffer))) 368 | (setq paradox--wiki-packages (read (current-buffer)))) 369 | (error (paradox--handle-failed-download)))) 370 | 371 | (defun paradox--package-star-count (package) 372 | "Get the star count of PACKAGE." 373 | (let ((count (gethash package paradox--star-count nil)) 374 | (repo (gethash package paradox--package-repo-list nil))) 375 | (propertize 376 | (format "%s" (or count "")) 377 | 'font-lock-face 378 | (if (and repo (paradox--starred-repo-p repo)) 379 | 'paradox-starred-face 380 | 'paradox-star-face)))) 381 | 382 | (defun paradox--star-predicate (A B) 383 | "Non-nil t if star count of A is larger than B." 384 | (> (string-to-number (elt (cadr A) paradox--column-index-star)) 385 | (string-to-number (elt (cadr B) paradox--column-index-star)))) 386 | (defun paradox--download-predicate (A B) 387 | "Non-nil t if download count of A is larger than B." 388 | (> (get-text-property 0 'value (elt (cadr A) paradox--column-index-download)) 389 | (get-text-property 0 'value (elt (cadr B) paradox--column-index-download)))) 390 | 391 | (defun paradox--generate-menu (remember-pos packages &optional keywords) 392 | "Populate the Package Menu, without hacking into the header-format. 393 | If REMEMBER-POS is non-nil, keep point on the same entry. 394 | PACKAGES should be t, which means to display all known packages, 395 | or a list of package names (symbols) to display. 396 | 397 | With KEYWORDS given, only packages with those keywords are 398 | shown." 399 | (paradox-menu--refresh packages keywords) 400 | (setq paradox--current-filter 401 | (if keywords (mapconcat 'identity keywords ",") 402 | nil)) 403 | (let ((idx (paradox--column-index "Package"))) 404 | (when (integerp idx) 405 | (setcar (elt tabulated-list-format idx) 406 | (if keywords 407 | (concat "Package[" paradox--current-filter "]") 408 | "Package")))) 409 | (tabulated-list-print remember-pos) 410 | (tabulated-list-init-header) 411 | (paradox--update-mode-line)) 412 | 413 | (defcustom paradox-hide-wiki-packages nil 414 | "If non-nil, don't display packages from the emacswiki." 415 | :type 'boolean) 416 | 417 | (defun paradox--maybe-remove-wiki-packages (pkgs) 418 | "Remove wiki packages from PKGS. 419 | If `paradox-hide-wiki-packages' is nil, just return PKGS." 420 | (if (not paradox-hide-wiki-packages) 421 | pkgs 422 | (remq nil 423 | (mapcar 424 | (lambda (entry) 425 | (let ((name (or (car-safe entry) entry))) 426 | (unless (gethash name paradox--wiki-packages) 427 | name))) 428 | (if (or (not pkgs) (eq t pkgs)) 429 | package-archive-contents 430 | pkgs))))) 431 | 432 | (defun paradox-menu--refresh (&optional packages keywords) 433 | "Call `package-menu--refresh' retaining current filter. 434 | PACKAGES and KEYWORDS are passed to `package-menu--refresh'. If 435 | KEYWORDS is nil and `paradox--current-filter' is non-nil, it is 436 | used to define keywords." 437 | (mapc (lambda (x) (setf (cdr x) 0)) paradox--package-count) 438 | (let ((paradox--desc-prefix (if (> paradox-lines-per-entry 1) " \n " "")) 439 | (paradox--desc-suffix (make-string (max 0 (- paradox-lines-per-entry 2)) ?\n))) 440 | (cond 441 | ((or packages keywords (not paradox--current-filter)) 442 | (package-menu--refresh 443 | (paradox--maybe-remove-wiki-packages packages) 444 | keywords) 445 | (paradox-refresh-upgradeable-packages)) 446 | ((string= paradox--current-filter "Upgradable") 447 | (paradox-refresh-upgradeable-packages) 448 | (paradox-filter-upgrades)) 449 | ((string= paradox--current-filter "Starred") 450 | (paradox-filter-stars) 451 | (paradox-refresh-upgradeable-packages)) 452 | ((string-match "\\`Regexp:\\(.*\\)\\'" paradox--current-filter) 453 | (paradox-filter-regexp (match-string 1 paradox--current-filter)) 454 | (paradox-refresh-upgradeable-packages)) 455 | (t 456 | (paradox-menu--refresh 457 | packages (split-string paradox--current-filter ",")))))) 458 | 459 | (defun paradox--column-index (regexp) 460 | "Find the index of the column that matches REGEXP." 461 | (cl-position (format "\\`%s\\'" (regexp-quote regexp)) tabulated-list-format 462 | :test (lambda (x y) (string-match x (or (car-safe y) ""))))) 463 | 464 | (defun paradox--count-format () 465 | "List of star/download counts to be used as part of the entry." 466 | (remove 467 | nil 468 | (list 469 | (when paradox-display-star-count 470 | (list paradox--column-name-star paradox-column-width-star 471 | 'paradox--star-predicate :right-align t)) 472 | (when paradox-display-download-count 473 | (list paradox--column-name-download paradox-column-width-download 474 | 'paradox--download-predicate :right-align t))))) 475 | 476 | (defun paradox--archive-format () 477 | "List containing archive to be used as part of the entry." 478 | (when (cdr package-archives) 479 | (list (list "Archive" 480 | (apply 'max (mapcar 'length (mapcar 'car package-archives))) 481 | 'package-menu--archive-predicate)))) 482 | 483 | (add-hook 'paradox-menu-mode-hook 'paradox-refresh-upgradeable-packages) 484 | 485 | 486 | ;;; Mode Definition 487 | (define-derived-mode paradox-menu-mode tabulated-list-mode "Paradox Menu" 488 | "Major mode for browsing a list of packages. 489 | Letters do not insert themselves; instead, they are commands. 490 | \\ 491 | \\{paradox-menu-mode-map}" 492 | (hl-line-mode 1) 493 | (when (boundp 'package--post-download-archives-hook) 494 | (add-hook 'package--post-download-archives-hook 495 | #'paradox--stop-spinner)) 496 | (if (boundp 'package--downloads-in-progress) 497 | (setq mode-line-process 498 | '("" (package--downloads-in-progress 499 | (":Loading " 500 | (paradox--spinner 501 | (:eval (spinner-print paradox--spinner)) 502 | (:eval (paradox--start-spinner)))) 503 | (paradox--spinner 504 | (":Executing " (:eval (spinner-print paradox--spinner))))))) 505 | (setq mode-line-process 506 | '(paradox--spinner 507 | (":Executing " (:eval (spinner-print paradox--spinner)))))) 508 | (paradox--update-mode-line) 509 | (setq tabulated-list-format 510 | `[("Package" ,paradox-column-width-package package-menu--name-predicate) 511 | ("Version" ,paradox-column-width-version paradox--version-predicate) 512 | ("Status" ,paradox-column-width-status package-menu--status-predicate) 513 | ,@(paradox--archive-format) 514 | ,@(paradox--count-format) 515 | ("Description" 0 nil)]) 516 | (setq paradox--column-index-star 517 | (paradox--column-index paradox--column-name-star)) 518 | (setq paradox--column-index-download 519 | (paradox--column-index paradox--column-name-download)) 520 | (setq tabulated-list-padding 2) 521 | (setq tabulated-list-sort-key (cons "Status" nil)) 522 | (add-hook 'tabulated-list-revert-hook #'paradox-menu--refresh nil t) 523 | (add-hook 'tabulated-list-revert-hook #'paradox-refresh-upgradeable-packages nil t) 524 | ;; (add-hook 'tabulated-list-revert-hook #'paradox--refresh-remote-data nil t) 525 | (add-hook 'tabulated-list-revert-hook #'paradox--update-mode-line 'append t) 526 | (tabulated-list-init-header) 527 | ;; We need package-menu-mode to be our parent, otherwise some 528 | ;; commands throw errors. But we can't actually derive from it, 529 | ;; otherwise its initialization will screw up the header-format. So 530 | ;; we "patch" it like this. 531 | (put 'paradox-menu-mode 'derived-mode-parent 'package-menu-mode) 532 | (run-hooks 'package-menu-mode-hook)) 533 | 534 | (put 'paradox-menu-mode 'derived-mode-parent 'package-menu-mode) 535 | 536 | (defun paradox--define-sort (name &optional key) 537 | "Define sorting by column NAME and bind it to KEY. 538 | Defines a function called paradox-sort-by-NAME." 539 | (let ((symb (intern (format "paradox-sort-by-%s" (downcase name)))) 540 | (key (or key (substring name 0 1)))) 541 | (eval 542 | `(progn 543 | (defun ,symb 544 | (invert) 545 | ,(format "Sort Package Menu by the %s column." name) 546 | (interactive "P") 547 | (when invert 548 | (setq tabulated-list-sort-key (cons ,name nil))) 549 | (tabulated-list--sort-by-column-name ,name)) 550 | (define-key paradox-menu-mode-map ,(concat "S" (upcase key)) ',symb) 551 | (define-key paradox-menu-mode-map ,(concat "S" (downcase key)) ',symb))))) 552 | 553 | (paradox--define-sort "Package") 554 | (paradox--define-sort "Status") 555 | (paradox--define-sort paradox--column-name-star "*") 556 | (paradox--define-sort "Version") 557 | (declare-function paradox-sort-by-package "paradox-menu") 558 | (declare-function paradox-sort-by-version "paradox-menu") 559 | 560 | (defun paradox--version-predicate (package-a package-b) 561 | "Predicate for sorting by the Version column. 562 | Versions are compared semantically in descending order." 563 | (let ((a (package-desc-version (car package-a))) 564 | (b (package-desc-version (car package-b)))) 565 | (cond ((version-list-= a b) 566 | (package-menu--name-predicate package-a package-b)) 567 | (t 568 | (version-list-< b a))))) 569 | 570 | (defalias 'paradox-filter-clear #'package-show-package-list 571 | "Clear current Package filter. 572 | Redisplay the Packages buffer listing all packages, without 573 | fetching the list.") 574 | 575 | (defmacro paradox--apply-filter (name packages &optional nil-message) 576 | "Apply filter called NAME (a string) listing only PACKAGES. 577 | PACKAGES should be a list of symbols (the names of packages to 578 | display) or a list of cons cells whose `car's are symbols. 579 | NIL-MESSAGE is the message to show if PACKAGES is nil, and 580 | defaults to: \"No %s packages\"." 581 | (declare (debug t) 582 | (indent 1)) 583 | (let* ((n (format "%s" name)) 584 | (cn (capitalize n)) 585 | (dn (downcase n))) 586 | (macroexp-let2 macroexp-copyable-p pl packages 587 | `(if (null ,pl) 588 | (user-error ,(or nil-message (format "No %s packages." dn))) 589 | (package-show-package-list 590 | (mapcar (lambda (p) (or (car-safe p) p)) ,pl)) 591 | (setq paradox--current-filter ,cn))))) 592 | 593 | (defun paradox-filter-upgrades () 594 | "Show only upgradable packages." 595 | (interactive) 596 | (paradox--apply-filter Upgradable 597 | paradox--upgradeable-packages) 598 | (paradox-sort-by-package nil)) 599 | 600 | (defun paradox-filter-stars () 601 | "Show only starred packages." 602 | (interactive) 603 | (let ((list)) 604 | (maphash (lambda (pkg repo) 605 | (when (paradox--starred-repo-p repo) 606 | (push pkg list))) 607 | paradox--package-repo-list) 608 | (paradox--apply-filter Starred list))) 609 | 610 | (defun paradox-filter-regexp (regexp) 611 | "Show only packages matching REGEXP. 612 | Test match against name and summary." 613 | (interactive (list (read-regexp "Enter Regular Expression: "))) 614 | (paradox--apply-filter Regexp 615 | (cl-remove-if-not 616 | (lambda (package) 617 | (or (string-match-p regexp (symbol-name (car package))) 618 | (string-match-p regexp (package-desc-summary (cadr package))))) 619 | package-archive-contents) 620 | "No packages match this regexp.") 621 | (setq paradox--current-filter (concat "Regexp:" regexp))) 622 | 623 | (set-keymap-parent paradox-menu-mode-map package-menu-mode-map) 624 | (define-key paradox-menu-mode-map "q" #'paradox-quit-and-close) 625 | (define-key paradox-menu-mode-map "p" #'paradox-previous-entry) 626 | (define-key paradox-menu-mode-map "n" #'paradox-next-entry) 627 | (define-key paradox-menu-mode-map "k" #'paradox-previous-describe) 628 | (define-key paradox-menu-mode-map "j" #'paradox-next-describe) 629 | (define-key paradox-menu-mode-map "s" #'paradox-menu-mark-star-unstar) 630 | (define-key paradox-menu-mode-map "h" #'paradox-menu-quick-help) 631 | (define-key paradox-menu-mode-map "v" #'paradox-menu-visit-homepage) 632 | (define-key paradox-menu-mode-map "w" #'paradox-menu-copy-homepage-as-kill) 633 | (define-key paradox-menu-mode-map "l" #'paradox-menu-view-commit-list) 634 | (define-key paradox-menu-mode-map "x" #'paradox-menu-execute) 635 | (define-key paradox-menu-mode-map "\r" #'paradox-push-button) 636 | (define-key paradox-menu-mode-map "F" 'package-menu-filter) 637 | (if (version< emacs-version "25") 638 | (defhydra hydra-paradox-filter (:color blue :hint nil) 639 | " 640 | Filter by: 641 | _u_pgrades _r_egexp _k_eyword _s_tarred _c_lear 642 | " 643 | ("f" package-menu-filter) 644 | ("k" package-menu-filter) 645 | ("r" paradox-filter-regexp) 646 | ("u" paradox-filter-upgrades) 647 | ("s" paradox-filter-stars) 648 | ("c" paradox-filter-clear) 649 | ("g" paradox-filter-clear) 650 | ("q" nil "cancel" :color blue)) 651 | (defhydra hydra-paradox-filter (:color blue :hint nil) 652 | " 653 | Filter by: 654 | _u_pgrades _r_egexp _k_eyword _s_tarred _c_lear 655 | Archive: g_n_u _o_ther 656 | Status: _i_nstalled _a_vailable _d_ependency _b_uilt-in 657 | " 658 | ("f" package-menu-filter) 659 | ("k" package-menu-filter) 660 | ("n" (package-menu-filter "arc:gnu")) 661 | ("o" (package-menu-filter 662 | (remove "arc:gnu" 663 | (mapcar (lambda (e) (concat "arc:" (car e))) 664 | package-archives)))) 665 | ("r" paradox-filter-regexp) 666 | ("u" paradox-filter-upgrades) 667 | ("s" paradox-filter-stars) 668 | ("i" (package-menu-filter "status:installed")) 669 | ("a" (package-menu-filter "status:available")) 670 | ("b" (package-menu-filter "status:built-in")) 671 | ("d" (package-menu-filter "status:dependency")) 672 | ("c" paradox-filter-clear) 673 | ("g" paradox-filter-clear) 674 | ("q" nil "cancel" :color blue))) 675 | (define-key paradox-menu-mode-map "f" #'hydra-paradox-filter/body) 676 | 677 | ;;; for those who don't want a hydra 678 | (defvar paradox--filter-map) 679 | (define-prefix-command 'paradox--filter-map) 680 | (define-key paradox--filter-map "k" #'package-menu-filter) 681 | (define-key paradox--filter-map "f" #'package-menu-filter) 682 | (define-key paradox--filter-map "r" #'paradox-filter-regexp) 683 | (define-key paradox--filter-map "u" #'paradox-filter-upgrades) 684 | (define-key paradox--filter-map "s" #'paradox-filter-stars) 685 | (define-key paradox--filter-map "c" #'paradox-filter-clear) 686 | 687 | (easy-menu-define paradox-menu-mode-menu paradox-menu-mode-map 688 | "Menu for `paradox-menu-mode'." 689 | `("Paradox" 690 | ["Describe Package" package-menu-describe-package :help "Display information about this package"] 691 | ["Help" paradox-menu-quick-help :help "Show short key binding help for package-menu-mode"] 692 | 693 | "--" 694 | ["Refresh Package List" package-menu-refresh 695 | :help "Redownload the ELPA archive" 696 | :active (not package--downloads-in-progress)] 697 | ["Execute Marked Actions" paradox-menu-execute :help "Perform all the marked actions"] 698 | ["Mark All Available Upgrades" package-menu-mark-upgrades 699 | :help "Mark packages that have a newer version for upgrading" 700 | :active (not package--downloads-in-progress)] 701 | 702 | ("Other Mark Actions" 703 | ["Mark All Obsolete for Deletion" package-menu-mark-obsolete-for-deletion :help "Mark all obsolete packages for deletion"] 704 | ["Mark for Install" package-menu-mark-install :help "Mark a package for installation and move to the next line"] 705 | ["Mark for Deletion" package-menu-mark-delete :help "Mark a package for deletion and move to the next line"] 706 | ["Unmark" package-menu-mark-unmark :help "Clear any marks on a package and move to the next line"]) 707 | 708 | "--" 709 | ("Github" :visible (stringp paradox-github-token) 710 | ["Star or unstar this package" paradox-menu-mark-star-unstar] 711 | ["Star all installed packages" paradox-star-all-installed-packages] 712 | ["Star packages when installing" (customize-save-variable 'paradox-automatically-star (not paradox-automatically-star)) 713 | :help "Automatically star packages that you install (and unstar packages you delete)" 714 | :style toggle :selected paradox-automatically-star]) 715 | ["Configure Github Inegration" (paradox--check-github-token) :visible (not paradox-github-token)] 716 | ["View Changelog" paradox-menu-view-commit-list :help "Show a package's commit list on Github"] 717 | ["Visit Homepage" paradox-menu-visit-homepage :help "Visit a package's Homepage on a browser"] 718 | 719 | "--" 720 | ("Filter Package List" 721 | ["Clear filter" paradox-filter-clear :help "Go back to unfiltered list"] 722 | ["By Keyword" package-menu-filter :help "Filter by package keyword"] 723 | ["By Upgrades" paradox-filter-upgrades :help "List only upgradeable packages"] 724 | ["By Regexp" paradox-filter-regexp :help "Filter packages matching a regexp"] 725 | ["By Starred" paradox-filter-stars :help "List only packages starred by the user"]) 726 | ("Sort Package List" 727 | ["By Package Name" paradox-sort-by-package] 728 | ["By Status (default)" paradox-sort-by-status] 729 | ["By Number of Stars" paradox-sort-by-★] 730 | ["By Version" paradox-sort-by-version]) 731 | ["Hide by Regexp" package-menu-hide-package :help "Permanently hide all packages matching a regexp"] 732 | ["Display Older Versions" package-menu-toggle-hiding 733 | :style toggle :selected (not package-menu--hide-packages) 734 | :help "Display package even if a newer version is already installed"] 735 | 736 | "--" 737 | ["Quit" quit-window :help "Quit package selection"] 738 | ["Customize" (customize-group 'package)])) 739 | 740 | 741 | ;;; Menu Mode Commands 742 | (defun paradox-previous-entry (&optional n) 743 | "Move to previous entry, which might not be the previous line. 744 | With prefix N, move to the N-th previous entry." 745 | (interactive "p") 746 | (paradox-next-entry (- (prefix-numeric-value n))) 747 | (forward-line 0) 748 | (forward-button 1)) 749 | 750 | (defun paradox-next-entry (&optional n) 751 | "Move to next entry, which might not be the next line. 752 | With prefix N, move to the N-th next entry." 753 | (interactive "p") 754 | (setq n (prefix-numeric-value n)) 755 | (let ((d (cl-signum n))) 756 | (dotimes (_ (abs n)) 757 | (forward-line (max d 0)) 758 | (if (eobp) (forward-line -1)) 759 | (forward-button d)))) 760 | 761 | (defun paradox-next-describe (&optional n) 762 | "Move to the next package and describe it. 763 | With prefix N, move to the N-th next package instead." 764 | (interactive "p") 765 | (paradox-next-entry n) 766 | (call-interactively 'package-menu-describe-package)) 767 | 768 | (defun paradox-previous-describe (&optional n) 769 | "Move to the previous package and describe it. 770 | With prefix N, move to the N-th previous package instead." 771 | (interactive "p") 772 | (paradox-previous-entry n) 773 | (call-interactively 'package-menu-describe-package)) 774 | 775 | (defun paradox-push-button () 776 | "Push button under point, or describe package." 777 | (interactive) 778 | (or (push-button) 779 | (call-interactively #'package-menu-describe-package))) 780 | 781 | (defvar paradox--key-descriptors 782 | '(("next," "previous," "install," "delete," ("execute," . 1) "refresh," "help") 783 | ("star," "visit homepage," "unmark," ("mark Upgrades," . 5) "~delete obsolete") 784 | ("list commits") 785 | ("filter by" "+" "upgrades" "regexp" "keyword" "starred" "clear") 786 | ("Sort by" "+" "Package name" "Status" "*(star)"))) 787 | 788 | (defun paradox-menu-quick-help () 789 | "Show short key binding help for `paradox-menu-mode'. 790 | The full list of keys can be viewed with \\[describe-mode]." 791 | (interactive) 792 | (message (mapconcat 'paradox--prettify-key-descriptor 793 | paradox--key-descriptors "\n"))) 794 | 795 | (defun paradox-quit-and-close (kill) 796 | "Bury this buffer and close the window. 797 | With prefix KILL, kill the buffer instead of burying." 798 | (interactive "P") 799 | (let ((log (get-buffer-window paradox--commit-list-buffer))) 800 | (when (window-live-p log) 801 | (quit-window kill log)) 802 | (quit-window kill))) 803 | 804 | (defun paradox-menu-visit-homepage (pkg) 805 | "Visit the homepage of package named PKG. 806 | PKG is a symbol. Interactively it is the package under point." 807 | (interactive '(nil)) 808 | (let ((url (paradox--package-homepage 809 | (paradox--get-or-return-package pkg)))) 810 | (if (stringp url) 811 | (browse-url url) 812 | (message "Package %s has no homepage." 813 | (propertize (symbol-name pkg) 814 | 'face 'font-lock-keyword-face))))) 815 | 816 | (defun paradox-menu-copy-homepage-as-kill (pkg) 817 | "Save the homepage of package named PKG as kill. 818 | PKG is a symbol. Interactively it is the package under point." 819 | (interactive '(nil)) 820 | (let ((url (paradox--package-homepage 821 | (paradox--get-or-return-package pkg)))) 822 | (if (stringp url) 823 | (progn (kill-new url) 824 | (message "copied \"%s\"" url)) 825 | (message "Package %s has no homepage." 826 | (propertize (symbol-name pkg) 827 | 'face 'font-lock-keyword-face))))) 828 | 829 | (defun paradox-menu-mark-star-unstar () 830 | "Star or unstar a package and move to the next line." 831 | (interactive) 832 | (paradox--enforce-github-token 833 | (unless paradox--user-starred-repos 834 | (paradox--refresh-user-starred-list)) 835 | ;; Get package name 836 | (let* ((pkg (paradox--get-or-return-package nil)) 837 | (repo (gethash pkg paradox--package-repo-list)) 838 | will-delete) 839 | (unless pkg (error "Couldn't find package-name for this entry")) 840 | ;; (Un)Star repo 841 | (if (not repo) 842 | (message "This package is not a GitHub repo.") 843 | (setq will-delete (paradox--starred-repo-p repo)) 844 | (paradox--star-repo repo will-delete) 845 | (cl-incf (gethash pkg paradox--star-count 0) 846 | (if will-delete -1 1)) 847 | (tabulated-list-set-col paradox--column-name-star 848 | (paradox--package-star-count pkg))))) 849 | (forward-line 1)) 850 | 851 | (defun paradox-menu-view-commit-list (pkg) 852 | "Visit the commit list of package named PKG. 853 | PKG is a symbol. Interactively it is the package under point." 854 | (interactive '(nil)) 855 | (let* ((name (paradox--get-or-return-package pkg)) 856 | (repo (gethash name paradox--package-repo-list))) 857 | (if repo 858 | (with-selected-window 859 | (display-buffer (get-buffer-create paradox--commit-list-buffer)) 860 | (paradox-commit-list-mode) 861 | (setq paradox--package-repo repo) 862 | (setq paradox--package-name name) 863 | (setq paradox--package-version 864 | (paradox--get-installed-version name)) 865 | (setq paradox--package-tag-commit-alist 866 | (paradox--get-tag-commit-alist repo)) 867 | (paradox--commit-list-update-entries) 868 | (tabulated-list-print)) 869 | (message "Package %s is not a GitHub repo." pkg)))) 870 | 871 | 872 | ;;; Mode-line Construction 873 | (defcustom paradox-local-variables 874 | '(mode-line-mule-info 875 | mode-line-client 876 | mode-line-remote mode-line-position 877 | column-number-mode size-indication-mode) 878 | "Variables which will take special values on the Packages buffer. 879 | This is a list, where each element is either SYMBOL or (SYMBOL . VALUE). 880 | 881 | Each SYMBOL (if it is bound) will be locally set to VALUE (or 882 | nil) on the Packages buffer." 883 | :type '(repeat (choice symbol (cons symbol sexp))) 884 | :group 'paradox-menu 885 | :package-version '(paradox . "0.1")) 886 | 887 | (defcustom paradox-display-buffer-name nil 888 | "If nil, *Packages* buffer name won't be displayed in the mode-line." 889 | :type 'boolean 890 | :group 'paradox-menu 891 | :package-version '(paradox . "0.2")) 892 | 893 | (defun paradox--build-buffer-id (st n) 894 | "Return a list that propertizes ST and N for the mode-line." 895 | `((:propertize ,st 896 | face paradox-mode-line-face) 897 | (:propertize ,(int-to-string n) 898 | face mode-line-buffer-id))) 899 | 900 | (defun paradox--update-mode-line () 901 | "Update `mode-line-format'." 902 | (mapc #'paradox--set-local-value paradox-local-variables) 903 | (let ((total-lines (int-to-string (length tabulated-list-entries)))) 904 | (paradox--update-mode-line-front-space total-lines) 905 | (paradox--update-mode-line-buffer-identification total-lines))) 906 | 907 | (defun paradox--update-mode-line-buffer-identification (_total-lines) 908 | "Update `mode-line-buffer-identification'. 909 | TOTAL-LINES is currently unused." 910 | (require 'spinner) 911 | (setq mode-line-buffer-identification 912 | `((paradox-display-buffer-name 913 | ,(propertized-buffer-identification 914 | (format "%%%sb" (length (buffer-name))))) 915 | (paradox--current-filter (:propertize ("[" paradox--current-filter "]") face paradox-mode-line-face)) 916 | (paradox--upgradeable-packages-any? 917 | (:eval (paradox--build-buffer-id " Upgrade:" paradox--upgradeable-packages-number))) 918 | (package-menu--new-package-list 919 | (:eval (paradox--build-buffer-id " New:" (paradox--cas "new")))) 920 | ,(paradox--build-buffer-id " Installed:" (+ (paradox--cas "installed") 921 | (paradox--cas "dependency") 922 | (paradox--cas "unsigned"))) 923 | (paradox--current-filter 924 | "" ,(paradox--build-buffer-id " Total:" (length package-archive-contents)))))) 925 | 926 | (defvar sml/col-number) 927 | (defvar sml/numbers-separator) 928 | (defvar sml/col-number-format) 929 | (defvar sml/line-number-format) 930 | (defvar sml/position-construct) 931 | (declare-function sml/compile-position-construct "sml") 932 | (defvar sml/post-id-separator) 933 | (defun paradox--update-mode-line-front-space (total-lines) 934 | "Update `mode-line-front-space'. 935 | TOTAL-LINES is the number of lines in the buffer." 936 | (if (memq 'sml/post-id-separator mode-line-format) 937 | (progn 938 | (add-to-list (make-local-variable 'mode-line-front-space) 939 | (propertize " (" 'face 'sml/col-number)) 940 | (setq column-number-mode line-number-mode) 941 | (set (make-local-variable 'sml/numbers-separator) "") 942 | (set (make-local-variable 'sml/col-number-format) 943 | (format "/%s)" total-lines)) 944 | (set (make-local-variable 'sml/line-number-format) 945 | (format "%%%sl" (length total-lines))) 946 | (make-local-variable 'sml/position-construct) 947 | (sml/compile-position-construct)) 948 | (set (make-local-variable 'mode-line-front-space) 949 | `(line-number-mode 950 | ("(" (:propertize ,(format "%%%sl" (length total-lines)) face mode-line-buffer-id) "/" 951 | ,total-lines ")"))) 952 | (set (make-local-variable 'mode-line-modified) nil))) 953 | 954 | (defun paradox--set-local-value (x) 955 | "Locally set value of (car X) to (cdr X)." 956 | (let ((sym (or (car-safe x) x))) 957 | (when (boundp sym) 958 | (set (make-local-variable sym) (cdr-safe x))))) 959 | 960 | (defun paradox--prettify-key-descriptor (desc) 961 | "Prettify DESC to be displayed as a help menu." 962 | (if (listp desc) 963 | (if (listp (cdr desc)) 964 | (mapconcat 'paradox--prettify-key-descriptor desc " ") 965 | (let ((place (cdr desc)) 966 | (out (car desc))) 967 | (setq out (propertize out 'face 'paradox-comment-face)) 968 | (add-text-properties place (1+ place) '(face paradox-highlight-face) out) 969 | out)) 970 | (paradox--prettify-key-descriptor (cons desc 0)))) 971 | 972 | (provide 'paradox-menu) 973 | ;;; paradox-menu.el ends here 974 | -------------------------------------------------------------------------------- /helpers/dash.el: -------------------------------------------------------------------------------- 1 | ;;; dash.el --- A modern list library for Emacs 2 | 3 | ;; Copyright (C) 2012 Magnar Sveen 4 | 5 | ;; Author: Magnar Sveen 6 | ;; Version: 20140407.253 7 | ;; X-Original-Version: 2.6.0 8 | ;; Keywords: lists 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 | ;; A modern list api for Emacs. 26 | ;; 27 | ;; See documentation on https://github.com/magnars/dash.el#functions 28 | 29 | ;;; Code: 30 | 31 | (defgroup dash () 32 | "Customize group for dash.el" 33 | :group 'lisp 34 | :prefix "dash-") 35 | 36 | (defun dash--enable-fontlock (symbol value) 37 | (when value 38 | (dash-enable-font-lock)) 39 | (set-default symbol value)) 40 | 41 | (defcustom dash-enable-fontlock nil 42 | "If non-nil, enable fontification of dash functions, macros and 43 | special values." 44 | :type 'boolean 45 | :set 'dash--enable-fontlock 46 | :group 'dash) 47 | 48 | (defmacro !cons (car cdr) 49 | "Destructive: Sets CDR to the cons of CAR and CDR." 50 | `(setq ,cdr (cons ,car ,cdr))) 51 | 52 | (defmacro !cdr (list) 53 | "Destructive: Sets LIST to the cdr of LIST." 54 | `(setq ,list (cdr ,list))) 55 | 56 | (defmacro --each (list &rest body) 57 | "Anaphoric form of `-each'." 58 | (declare (debug (form body)) 59 | (indent 1)) 60 | (let ((l (make-symbol "list"))) 61 | `(let ((,l ,list) 62 | (it-index 0)) 63 | (while ,l 64 | (let ((it (car ,l))) 65 | ,@body) 66 | (setq it-index (1+ it-index)) 67 | (!cdr ,l))))) 68 | 69 | (defun -each (list fn) 70 | "Calls FN with every item in LIST. Returns nil, used for side-effects only." 71 | (--each list (funcall fn it))) 72 | 73 | (put '-each 'lisp-indent-function 1) 74 | 75 | (defmacro --each-while (list pred &rest body) 76 | "Anaphoric form of `-each-while'." 77 | (declare (debug (form form body)) 78 | (indent 2)) 79 | (let ((l (make-symbol "list")) 80 | (c (make-symbol "continue"))) 81 | `(let ((,l ,list) 82 | (,c t)) 83 | (while (and ,l ,c) 84 | (let ((it (car ,l))) 85 | (if (not ,pred) (setq ,c nil) ,@body)) 86 | (!cdr ,l))))) 87 | 88 | (defun -each-while (list pred fn) 89 | "Calls FN with every item in LIST while (PRED item) is non-nil. 90 | Returns nil, used for side-effects only." 91 | (--each-while list (funcall pred it) (funcall fn it))) 92 | 93 | (put '-each-while 'lisp-indent-function 2) 94 | 95 | (defmacro --dotimes (num &rest body) 96 | "Repeatedly executes BODY (presumably for side-effects) with `it` bound to integers from 0 through NUM-1." 97 | (declare (debug (form body)) 98 | (indent 1)) 99 | (let ((n (make-symbol "num"))) 100 | `(let ((,n ,num) 101 | (it 0)) 102 | (while (< it ,n) 103 | ,@body 104 | (setq it (1+ it)))))) 105 | 106 | (defun -dotimes (num fn) 107 | "Repeatedly calls FN (presumably for side-effects) passing in integers from 0 through NUM-1." 108 | (--dotimes num (funcall fn it))) 109 | 110 | (put '-dotimes 'lisp-indent-function 1) 111 | 112 | (defun -map (fn list) 113 | "Returns a new list consisting of the result of applying FN to the items in LIST." 114 | (mapcar fn list)) 115 | 116 | (defmacro --map (form list) 117 | "Anaphoric form of `-map'." 118 | (declare (debug (form form))) 119 | `(mapcar (lambda (it) ,form) ,list)) 120 | 121 | (defmacro --reduce-from (form initial-value list) 122 | "Anaphoric form of `-reduce-from'." 123 | (declare (debug (form form form))) 124 | `(let ((acc ,initial-value)) 125 | (--each ,list (setq acc ,form)) 126 | acc)) 127 | 128 | (defun -reduce-from (fn initial-value list) 129 | "Returns the result of applying FN to INITIAL-VALUE and the 130 | first item in LIST, then applying FN to that result and the 2nd 131 | item, etc. If LIST contains no items, returns INITIAL-VALUE and 132 | FN is not called. 133 | 134 | In the anaphoric form `--reduce-from', the accumulated value is 135 | exposed as `acc`." 136 | (--reduce-from (funcall fn acc it) initial-value list)) 137 | 138 | (defmacro --reduce (form list) 139 | "Anaphoric form of `-reduce'." 140 | (declare (debug (form form))) 141 | (let ((lv (make-symbol "list-value"))) 142 | `(let ((,lv ,list)) 143 | (if ,lv 144 | (--reduce-from ,form (car ,lv) (cdr ,lv)) 145 | (let (acc it) ,form))))) 146 | 147 | (defun -reduce (fn list) 148 | "Returns the result of applying FN to the first 2 items in LIST, 149 | then applying FN to that result and the 3rd item, etc. If LIST 150 | contains no items, FN must accept no arguments as well, and 151 | reduce returns the result of calling FN with no arguments. If 152 | LIST has only 1 item, it is returned and FN is not called. 153 | 154 | In the anaphoric form `--reduce', the accumulated value is 155 | exposed as `acc`." 156 | (if list 157 | (-reduce-from fn (car list) (cdr list)) 158 | (funcall fn))) 159 | 160 | (defun -reduce-r-from (fn initial-value list) 161 | "Replace conses with FN, nil with INITIAL-VALUE and evaluate 162 | the resulting expression. If LIST is empty, INITIAL-VALUE is 163 | returned and FN is not called. 164 | 165 | Note: this function works the same as `-reduce-from' but the 166 | operation associates from right instead of from left." 167 | (if (not list) initial-value 168 | (funcall fn (car list) (-reduce-r-from fn initial-value (cdr list))))) 169 | 170 | (defmacro --reduce-r-from (form initial-value list) 171 | "Anaphoric version of `-reduce-r-from'." 172 | (declare (debug (form form form))) 173 | `(-reduce-r-from (lambda (&optional it acc) ,form) ,initial-value ,list)) 174 | 175 | (defun -reduce-r (fn list) 176 | "Replace conses with FN and evaluate the resulting expression. 177 | The final nil is ignored. If LIST contains no items, FN must 178 | accept no arguments as well, and reduce returns the result of 179 | calling FN with no arguments. If LIST has only 1 item, it is 180 | returned and FN is not called. 181 | 182 | The first argument of FN is the new item, the second is the 183 | accumulated value. 184 | 185 | Note: this function works the same as `-reduce' but the operation 186 | associates from right instead of from left." 187 | (cond 188 | ((not list) (funcall fn)) 189 | ((not (cdr list)) (car list)) 190 | (t (funcall fn (car list) (-reduce-r fn (cdr list)))))) 191 | 192 | (defmacro --reduce-r (form list) 193 | "Anaphoric version of `-reduce-r'." 194 | (declare (debug (form form))) 195 | `(-reduce-r (lambda (&optional it acc) ,form) ,list)) 196 | 197 | (defmacro --filter (form list) 198 | "Anaphoric form of `-filter'." 199 | (declare (debug (form form))) 200 | (let ((r (make-symbol "result"))) 201 | `(let (,r) 202 | (--each ,list (when ,form (!cons it ,r))) 203 | (nreverse ,r)))) 204 | 205 | (defun -filter (pred list) 206 | "Returns a new list of the items in LIST for which PRED returns a non-nil value. 207 | 208 | Alias: `-select'" 209 | (--filter (funcall pred it) list)) 210 | 211 | (defalias '-select '-filter) 212 | (defalias '--select '--filter) 213 | 214 | (defmacro --remove (form list) 215 | "Anaphoric form of `-remove'." 216 | (declare (debug (form form))) 217 | `(--filter (not ,form) ,list)) 218 | 219 | (defun -remove (pred list) 220 | "Returns a new list of the items in LIST for which PRED returns nil. 221 | 222 | Alias: `-reject'" 223 | (--remove (funcall pred it) list)) 224 | 225 | (defalias '-reject '-remove) 226 | (defalias '--reject '--remove) 227 | 228 | (defmacro --keep (form list) 229 | "Anaphoric form of `-keep'." 230 | (declare (debug (form form))) 231 | (let ((r (make-symbol "result")) 232 | (m (make-symbol "mapped"))) 233 | `(let (,r) 234 | (--each ,list (let ((,m ,form)) (when ,m (!cons ,m ,r)))) 235 | (nreverse ,r)))) 236 | 237 | (defun -keep (fn list) 238 | "Returns a new list of the non-nil results of applying FN to the items in LIST." 239 | (--keep (funcall fn it) list)) 240 | 241 | (defmacro --map-when (pred rep list) 242 | "Anaphoric form of `-map-when'." 243 | (declare (debug (form form form))) 244 | (let ((r (make-symbol "result"))) 245 | `(let (,r) 246 | (--each ,list (!cons (if ,pred ,rep it) ,r)) 247 | (nreverse ,r)))) 248 | 249 | (defmacro --map-indexed (form list) 250 | "Anaphoric form of `-map-indexed'." 251 | (declare (debug (form form))) 252 | (let ((r (make-symbol "result"))) 253 | `(let (,r) 254 | (--each ,list 255 | (!cons ,form ,r)) 256 | (nreverse ,r)))) 257 | 258 | (defun -map-indexed (fn list) 259 | "Returns a new list consisting of the result of (FN index item) for each item in LIST. 260 | 261 | In the anaphoric form `--map-indexed', the index is exposed as `it-index`." 262 | (--map-indexed (funcall fn it-index it) list)) 263 | 264 | (defun -map-when (pred rep list) 265 | "Returns a new list where the elements in LIST that does not match the PRED function 266 | are unchanged, and where the elements in LIST that do match the PRED function are mapped 267 | through the REP function." 268 | (--map-when (funcall pred it) (funcall rep it) list)) 269 | 270 | (defalias '--replace-where '--map-when) 271 | (defalias '-replace-where '-map-when) 272 | 273 | (defun -flatten (l) 274 | "Takes a nested list L and returns its contents as a single, flat list." 275 | (if (and (listp l) (listp (cdr l))) 276 | (-mapcat '-flatten l) 277 | (list l))) 278 | 279 | (defun -concat (&rest lists) 280 | "Returns a new list with the concatenation of the elements in the supplied LISTS." 281 | (apply 'append lists)) 282 | 283 | (defmacro --mapcat (form list) 284 | "Anaphoric form of `-mapcat'." 285 | (declare (debug (form form))) 286 | `(apply 'append (--map ,form ,list))) 287 | 288 | (defun -mapcat (fn list) 289 | "Returns the concatenation of the result of mapping FN over LIST. 290 | Thus function FN should return a list." 291 | (--mapcat (funcall fn it) list)) 292 | 293 | (defun -cons* (&rest args) 294 | "Makes a new list from the elements of ARGS. 295 | 296 | The last 2 members of ARGS are used as the final cons of the 297 | result so if the final member of ARGS is not a list the result is 298 | a dotted list." 299 | (-reduce-r 'cons args)) 300 | 301 | (defun -snoc (list elem &rest elements) 302 | "Append ELEM to the end of the list. 303 | 304 | This is like `cons', but operates on the end of list. 305 | 306 | If ELEMENTS is non nil, append these to the list as well." 307 | (-concat list (list elem) elements)) 308 | 309 | (defmacro --first (form list) 310 | "Anaphoric form of `-first'." 311 | (declare (debug (form form))) 312 | (let ((n (make-symbol "needle"))) 313 | `(let (,n) 314 | (--each-while ,list (not ,n) 315 | (when ,form (setq ,n it))) 316 | ,n))) 317 | 318 | (defun -first (pred list) 319 | "Returns the first x in LIST where (PRED x) is non-nil, else nil. 320 | 321 | To get the first item in the list no questions asked, use `car'." 322 | (--first (funcall pred it) list)) 323 | 324 | (defmacro --last (form list) 325 | "Anaphoric form of `-last'." 326 | (declare (debug (form form))) 327 | (let ((n (make-symbol "needle"))) 328 | `(let (,n) 329 | (--each ,list 330 | (when ,form (setq ,n it))) 331 | ,n))) 332 | 333 | (defun -last (pred list) 334 | "Return the last x in LIST where (PRED x) is non-nil, else nil." 335 | (--last (funcall pred it) list)) 336 | 337 | (defalias '-first-item 'car 338 | "Returns the first item of LIST, or nil on an empty list.") 339 | 340 | (defun -last-item (list) 341 | "Returns the last item of LIST, or nil on an empty list." 342 | (car (last list))) 343 | 344 | (defmacro --count (pred list) 345 | "Anaphoric form of `-count'." 346 | (declare (debug (form form))) 347 | (let ((r (make-symbol "result"))) 348 | `(let ((,r 0)) 349 | (--each ,list (when ,pred (setq ,r (1+ ,r)))) 350 | ,r))) 351 | 352 | (defun -count (pred list) 353 | "Counts the number of items in LIST where (PRED item) is non-nil." 354 | (--count (funcall pred it) list)) 355 | 356 | (defun ---truthy? (val) 357 | (not (null val))) 358 | 359 | (defmacro --any? (form list) 360 | "Anaphoric form of `-any?'." 361 | (declare (debug (form form))) 362 | `(---truthy? (--first ,form ,list))) 363 | 364 | (defun -any? (pred list) 365 | "Returns t if (PRED x) is non-nil for any x in LIST, else nil. 366 | 367 | Alias: `-some?'" 368 | (--any? (funcall pred it) list)) 369 | 370 | (defalias '-some? '-any?) 371 | (defalias '--some? '--any?) 372 | 373 | (defalias '-any-p '-any?) 374 | (defalias '--any-p '--any?) 375 | (defalias '-some-p '-any?) 376 | (defalias '--some-p '--any?) 377 | 378 | (defmacro --all? (form list) 379 | "Anaphoric form of `-all?'." 380 | (declare (debug (form form))) 381 | (let ((a (make-symbol "all"))) 382 | `(let ((,a t)) 383 | (--each-while ,list ,a (setq ,a ,form)) 384 | (---truthy? ,a)))) 385 | 386 | (defun -all? (pred list) 387 | "Returns t if (PRED x) is non-nil for all x in LIST, else nil. 388 | 389 | Alias: `-every?'" 390 | (--all? (funcall pred it) list)) 391 | 392 | (defalias '-every? '-all?) 393 | (defalias '--every? '--all?) 394 | 395 | (defalias '-all-p '-all?) 396 | (defalias '--all-p '--all?) 397 | (defalias '-every-p '-all?) 398 | (defalias '--every-p '--all?) 399 | 400 | (defmacro --none? (form list) 401 | "Anaphoric form of `-none?'." 402 | (declare (debug (form form))) 403 | `(--all? (not ,form) ,list)) 404 | 405 | (defun -none? (pred list) 406 | "Returns t if (PRED x) is nil for all x in LIST, else nil." 407 | (--none? (funcall pred it) list)) 408 | 409 | (defalias '-none-p '-none?) 410 | (defalias '--none-p '--none?) 411 | 412 | (defmacro --only-some? (form list) 413 | "Anaphoric form of `-only-some?'." 414 | (declare (debug (form form))) 415 | (let ((y (make-symbol "yes")) 416 | (n (make-symbol "no"))) 417 | `(let (,y ,n) 418 | (--each-while ,list (not (and ,y ,n)) 419 | (if ,form (setq ,y t) (setq ,n t))) 420 | (---truthy? (and ,y ,n))))) 421 | 422 | (defun -only-some? (pred list) 423 | "Returns `t` if there is a mix of items in LIST that matches and does not match PRED. 424 | Returns `nil` both if all items match the predicate, and if none of the items match the predicate." 425 | (--only-some? (funcall pred it) list)) 426 | 427 | (defalias '-only-some-p '-only-some?) 428 | (defalias '--only-some-p '--only-some?) 429 | 430 | (defun -slice (list from &optional to) 431 | "Return copy of LIST, starting from index FROM to index TO. 432 | FROM or TO may be negative." 433 | (let ((length (length list)) 434 | (new-list nil) 435 | (index 0)) 436 | ;; to defaults to the end of the list 437 | (setq to (or to length)) 438 | ;; handle negative indices 439 | (when (< from 0) 440 | (setq from (mod from length))) 441 | (when (< to 0) 442 | (setq to (mod to length))) 443 | 444 | ;; iterate through the list, keeping the elements we want 445 | (while (< index to) 446 | (when (>= index from) 447 | (!cons (car list) new-list)) 448 | (!cdr list) 449 | (setq index (1+ index))) 450 | (nreverse new-list))) 451 | 452 | (defun -take (n list) 453 | "Returns a new list of the first N items in LIST, or all items if there are fewer than N." 454 | (let (result) 455 | (--dotimes n 456 | (when list 457 | (!cons (car list) result) 458 | (!cdr list))) 459 | (nreverse result))) 460 | 461 | (defun -drop (n list) 462 | "Returns the tail of LIST without the first N items." 463 | (--dotimes n (!cdr list)) 464 | list) 465 | 466 | (defmacro --take-while (form list) 467 | "Anaphoric form of `-take-while'." 468 | (declare (debug (form form))) 469 | (let ((r (make-symbol "result"))) 470 | `(let (,r) 471 | (--each-while ,list ,form (!cons it ,r)) 472 | (nreverse ,r)))) 473 | 474 | (defun -take-while (pred list) 475 | "Returns a new list of successive items from LIST while (PRED item) returns a non-nil value." 476 | (--take-while (funcall pred it) list)) 477 | 478 | (defmacro --drop-while (form list) 479 | "Anaphoric form of `-drop-while'." 480 | (declare (debug (form form))) 481 | (let ((l (make-symbol "list"))) 482 | `(let ((,l ,list)) 483 | (while (and ,l (let ((it (car ,l))) ,form)) 484 | (!cdr ,l)) 485 | ,l))) 486 | 487 | (defun -drop-while (pred list) 488 | "Returns the tail of LIST starting from the first item for which (PRED item) returns nil." 489 | (--drop-while (funcall pred it) list)) 490 | 491 | (defun -split-at (n list) 492 | "Returns a list of ((-take N LIST) (-drop N LIST)), in no more than one pass through the list." 493 | (let (result) 494 | (--dotimes n 495 | (when list 496 | (!cons (car list) result) 497 | (!cdr list))) 498 | (list (nreverse result) list))) 499 | 500 | (defun -rotate (n list) 501 | "Rotate LIST N places to the right. With N negative, rotate to the left. 502 | The time complexity is O(n)." 503 | (if (> n 0) 504 | (append (last list n) (butlast list n)) 505 | (append (-drop (- n) list) (-take (- n) list)))) 506 | 507 | (defun -insert-at (n x list) 508 | "Returns a list with X inserted into LIST at position N." 509 | (let ((split-list (-split-at n list))) 510 | (nconc (car split-list) (cons x (cadr split-list))))) 511 | 512 | (defun -replace-at (n x list) 513 | "Return a list with element at Nth position in LIST replaced with X." 514 | (let ((split-list (-split-at n list))) 515 | (nconc (car split-list) (cons x (cdr (cadr split-list)))))) 516 | 517 | (defun -update-at (n func list) 518 | "Return a list with element at Nth position in LIST replaced with `(func (nth n list))`." 519 | (let ((split-list (-split-at n list))) 520 | (nconc (car split-list) (cons (funcall func (car (cadr split-list))) (cdr (cadr split-list)))))) 521 | 522 | (defmacro --update-at (n form list) 523 | "Anaphoric version of `-update-at'." 524 | (declare (debug (form form form))) 525 | `(-update-at ,n (lambda (it) ,form) ,list)) 526 | 527 | (defun -remove-at (n list) 528 | "Return a list with element at Nth position in LIST removed." 529 | (-remove-at-indices (list n) list)) 530 | 531 | (defun -remove-at-indices (indices list) 532 | "Return a list whose elements are elements from LIST without 533 | elements selected as `(nth i list)` for all i 534 | from INDICES." 535 | (let* ((indices (-sort '< indices)) 536 | (diffs (cons (car indices) (-map '1- (-zip-with '- (cdr indices) indices)))) 537 | r) 538 | (--each diffs 539 | (let ((split (-split-at it list))) 540 | (!cons (car split) r) 541 | (setq list (cdr (cadr split))))) 542 | (!cons list r) 543 | (apply '-concat (nreverse r)))) 544 | 545 | (defmacro --split-with (pred list) 546 | "Anaphoric form of `-split-with'." 547 | (declare (debug (form form))) 548 | (let ((l (make-symbol "list")) 549 | (r (make-symbol "result")) 550 | (c (make-symbol "continue"))) 551 | `(let ((,l ,list) 552 | (,r nil) 553 | (,c t)) 554 | (while (and ,l ,c) 555 | (let ((it (car ,l))) 556 | (if (not ,pred) 557 | (setq ,c nil) 558 | (!cons it ,r) 559 | (!cdr ,l)))) 560 | (list (nreverse ,r) ,l)))) 561 | 562 | (defun -split-with (pred list) 563 | "Returns a list of ((-take-while PRED LIST) (-drop-while PRED LIST)), in no more than one pass through the list." 564 | (--split-with (funcall pred it) list)) 565 | 566 | (defmacro -split-on (item list) 567 | "Split the LIST each time ITEM is found. 568 | 569 | Unlike `-partition-by', the ITEM is discarded from the results. 570 | Empty lists are also removed from the result. 571 | 572 | Comparison is done by `equal'. 573 | 574 | See also `-split-when'." 575 | (declare (debug (form form))) 576 | `(-split-when (lambda (it) (equal it ,item)) ,list)) 577 | 578 | (defmacro --split-when (form list) 579 | "Anaphoric version of `-split-when'." 580 | (declare (debug (form form))) 581 | `(-split-when (lambda (it) ,form) ,list)) 582 | 583 | (defun -split-when (fn list) 584 | "Split the LIST on each element where FN returns non-nil. 585 | 586 | Unlike `-partition-by', the \"matched\" element is discarded from 587 | the results. Empty lists are also removed from the result. 588 | 589 | This function can be thought of as a generalization of 590 | `split-string'." 591 | (let (r s) 592 | (while list 593 | (if (not (funcall fn (car list))) 594 | (push (car list) s) 595 | (when s (push (nreverse s) r)) 596 | (setq s nil)) 597 | (!cdr list)) 598 | (when s (push (nreverse s) r)) 599 | (nreverse r))) 600 | 601 | (defmacro --separate (form list) 602 | "Anaphoric form of `-separate'." 603 | (declare (debug (form form))) 604 | (let ((y (make-symbol "yes")) 605 | (n (make-symbol "no"))) 606 | `(let (,y ,n) 607 | (--each ,list (if ,form (!cons it ,y) (!cons it ,n))) 608 | (list (nreverse ,y) (nreverse ,n))))) 609 | 610 | (defun -separate (pred list) 611 | "Returns a list of ((-filter PRED LIST) (-remove PRED LIST)), in one pass through the list." 612 | (--separate (funcall pred it) list)) 613 | 614 | (defun ---partition-all-in-steps-reversed (n step list) 615 | "Private: Used by -partition-all-in-steps and -partition-in-steps." 616 | (when (< step 1) 617 | (error "Step must be a positive number, or you're looking at some juicy infinite loops.")) 618 | (let ((result nil) 619 | (len 0)) 620 | (while list 621 | (!cons (-take n list) result) 622 | (setq list (-drop step list))) 623 | result)) 624 | 625 | (defun -partition-all-in-steps (n step list) 626 | "Returns a new list with the items in LIST grouped into N-sized sublists at offsets STEP apart. 627 | The last groups may contain less than N items." 628 | (nreverse (---partition-all-in-steps-reversed n step list))) 629 | 630 | (defun -partition-in-steps (n step list) 631 | "Returns a new list with the items in LIST grouped into N-sized sublists at offsets STEP apart. 632 | If there are not enough items to make the last group N-sized, 633 | those items are discarded." 634 | (let ((result (---partition-all-in-steps-reversed n step list))) 635 | (while (and result (< (length (car result)) n)) 636 | (!cdr result)) 637 | (nreverse result))) 638 | 639 | (defun -partition-all (n list) 640 | "Returns a new list with the items in LIST grouped into N-sized sublists. 641 | The last group may contain less than N items." 642 | (-partition-all-in-steps n n list)) 643 | 644 | (defun -partition (n list) 645 | "Returns a new list with the items in LIST grouped into N-sized sublists. 646 | If there are not enough items to make the last group N-sized, 647 | those items are discarded." 648 | (-partition-in-steps n n list)) 649 | 650 | (defmacro --partition-by (form list) 651 | "Anaphoric form of `-partition-by'." 652 | (declare (debug (form form))) 653 | (let ((r (make-symbol "result")) 654 | (s (make-symbol "sublist")) 655 | (v (make-symbol "value")) 656 | (n (make-symbol "new-value")) 657 | (l (make-symbol "list"))) 658 | `(let ((,l ,list)) 659 | (when ,l 660 | (let* ((,r nil) 661 | (it (car ,l)) 662 | (,s (list it)) 663 | (,v ,form) 664 | (,l (cdr ,l))) 665 | (while ,l 666 | (let* ((it (car ,l)) 667 | (,n ,form)) 668 | (unless (equal ,v ,n) 669 | (!cons (nreverse ,s) ,r) 670 | (setq ,s nil) 671 | (setq ,v ,n)) 672 | (!cons it ,s) 673 | (!cdr ,l))) 674 | (!cons (nreverse ,s) ,r) 675 | (nreverse ,r)))))) 676 | 677 | (defun -partition-by (fn list) 678 | "Applies FN to each item in LIST, splitting it each time FN returns a new value." 679 | (--partition-by (funcall fn it) list)) 680 | 681 | (defmacro --partition-by-header (form list) 682 | "Anaphoric form of `-partition-by-header'." 683 | (declare (debug (form form))) 684 | (let ((r (make-symbol "result")) 685 | (s (make-symbol "sublist")) 686 | (h (make-symbol "header-value")) 687 | (b (make-symbol "seen-body?")) 688 | (n (make-symbol "new-value")) 689 | (l (make-symbol "list"))) 690 | `(let ((,l ,list)) 691 | (when ,l 692 | (let* ((,r nil) 693 | (it (car ,l)) 694 | (,s (list it)) 695 | (,h ,form) 696 | (,b nil) 697 | (,l (cdr ,l))) 698 | (while ,l 699 | (let* ((it (car ,l)) 700 | (,n ,form)) 701 | (if (equal ,h ,n) 702 | (when ,b 703 | (!cons (nreverse ,s) ,r) 704 | (setq ,s nil) 705 | (setq ,b nil)) 706 | (setq ,b t)) 707 | (!cons it ,s) 708 | (!cdr ,l))) 709 | (!cons (nreverse ,s) ,r) 710 | (nreverse ,r)))))) 711 | 712 | (defun -partition-by-header (fn list) 713 | "Applies FN to the first item in LIST. That is the header 714 | value. Applies FN to each item in LIST, splitting it each time 715 | FN returns the header value, but only after seeing at least one 716 | other value (the body)." 717 | (--partition-by-header (funcall fn it) list)) 718 | 719 | (defmacro --group-by (form list) 720 | "Anaphoric form of `-group-by'." 721 | (declare (debug (form form))) 722 | (let ((l (make-symbol "list")) 723 | (v (make-symbol "value")) 724 | (k (make-symbol "key")) 725 | (r (make-symbol "result"))) 726 | `(let ((,l ,list) 727 | ,r) 728 | ;; Convert `list' to an alist and store it in `r'. 729 | (while ,l 730 | (let* ((,v (car ,l)) 731 | (it ,v) 732 | (,k ,form) 733 | (kv (assoc ,k ,r))) 734 | (if kv 735 | (setcdr kv (cons ,v (cdr kv))) 736 | (push (list ,k ,v) ,r)) 737 | (setq ,l (cdr ,l)))) 738 | ;; Reverse lists in each group. 739 | (let ((rest ,r)) 740 | (while rest 741 | (let ((kv (car rest))) 742 | (setcdr kv (nreverse (cdr kv)))) 743 | (setq rest (cdr rest)))) 744 | ;; Reverse order of keys. 745 | (nreverse ,r)))) 746 | 747 | (defun -group-by (fn list) 748 | "Separate LIST into an alist whose keys are FN applied to the 749 | elements of LIST. Keys are compared by `equal'." 750 | (--group-by (funcall fn it) list)) 751 | 752 | (defun -interpose (sep list) 753 | "Returns a new list of all elements in LIST separated by SEP." 754 | (let (result) 755 | (when list 756 | (!cons (car list) result) 757 | (!cdr list)) 758 | (while list 759 | (setq result (cons (car list) (cons sep result))) 760 | (!cdr list)) 761 | (nreverse result))) 762 | 763 | (defun -interleave (&rest lists) 764 | "Returns a new list of the first item in each list, then the second etc." 765 | (let (result) 766 | (while (-none? 'null lists) 767 | (--each lists (!cons (car it) result)) 768 | (setq lists (-map 'cdr lists))) 769 | (nreverse result))) 770 | 771 | (defmacro --zip-with (form list1 list2) 772 | "Anaphoric form of `-zip-with'. 773 | 774 | The elements in list1 is bound as `it`, the elements in list2 as `other`." 775 | (declare (debug (form form form))) 776 | (let ((r (make-symbol "result")) 777 | (l1 (make-symbol "list1")) 778 | (l2 (make-symbol "list2"))) 779 | `(let ((,r nil) 780 | (,l1 ,list1) 781 | (,l2 ,list2)) 782 | (while (and ,l1 ,l2) 783 | (let ((it (car ,l1)) 784 | (other (car ,l2))) 785 | (!cons ,form ,r) 786 | (!cdr ,l1) 787 | (!cdr ,l2))) 788 | (nreverse ,r)))) 789 | 790 | (defun -zip-with (fn list1 list2) 791 | "Zip the two lists LIST1 and LIST2 using a function FN. This 792 | function is applied pairwise taking as first argument element of 793 | LIST1 and as second argument element of LIST2 at corresponding 794 | position. 795 | 796 | The anaphoric form `--zip-with' binds the elements from LIST1 as `it`, 797 | and the elements from LIST2 as `other`." 798 | (--zip-with (funcall fn it other) list1 list2)) 799 | 800 | (defun -zip (&rest lists) 801 | "Zip LISTS together. Group the head of each list, followed by the 802 | second elements of each list, and so on. The lengths of the returned 803 | groupings are equal to the length of the shortest input list. 804 | 805 | If two lists are provided as arguments, return the groupings as a list 806 | of cons cells. Otherwise, return the groupings as a list of lists. " 807 | (let* ((n (-min (-map 'length lists))) 808 | (level-lists (-map (-partial '-take n) lists)) 809 | results) 810 | (while (> n 0) 811 | (let ((split-lists (-map (-partial '-split-at 1) level-lists))) 812 | (setq results (cons (-map 'caar split-lists) results)) 813 | (setq level-lists (-map 'cadr split-lists)) 814 | (setq n (1- n)))) 815 | (setq results (nreverse results)) 816 | (if (= (length lists) 2) 817 | ; to support backward compatability, return 818 | ; a cons cell if two lists were provided 819 | (--map (cons (car it) (cadr it)) results) 820 | results))) 821 | 822 | (defun -partial (fn &rest args) 823 | "Takes a function FN and fewer than the normal arguments to FN, 824 | and returns a fn that takes a variable number of additional ARGS. 825 | When called, the returned function calls FN with ARGS first and 826 | then additional args." 827 | (apply 'apply-partially fn args)) 828 | 829 | (defun -elem-index (elem list) 830 | "Return the index of the first element in the given LIST which 831 | is equal to the query element ELEM, or nil if there is no 832 | such element." 833 | (car (-elem-indices elem list))) 834 | 835 | (defun -elem-indices (elem list) 836 | "Return the indices of all elements in LIST equal to the query 837 | element ELEM, in ascending order." 838 | (-find-indices (-partial 'equal elem) list)) 839 | 840 | (defun -find-indices (pred list) 841 | "Return the indices of all elements in LIST satisfying the 842 | predicate PRED, in ascending order." 843 | (let ((i 0)) 844 | (apply 'append (--map-indexed (when (funcall pred it) (list it-index)) list)))) 845 | 846 | (defmacro --find-indices (form list) 847 | "Anaphoric version of `-find-indices'." 848 | (declare (debug (form form))) 849 | `(-find-indices (lambda (it) ,form) ,list)) 850 | 851 | (defun -find-index (pred list) 852 | "Take a predicate PRED and a LIST and return the index of the 853 | first element in the list satisfying the predicate, or nil if 854 | there is no such element." 855 | (car (-find-indices pred list))) 856 | 857 | (defmacro --find-index (form list) 858 | "Anaphoric version of `-find-index'." 859 | (declare (debug (form form))) 860 | `(-find-index (lambda (it) ,form) ,list)) 861 | 862 | (defun -find-last-index (pred list) 863 | "Take a predicate PRED and a LIST and return the index of the 864 | last element in the list satisfying the predicate, or nil if 865 | there is no such element." 866 | (-last-item (-find-indices pred list))) 867 | 868 | (defmacro --find-last-index (form list) 869 | "Anaphoric version of `-find-last-index'." 870 | `(-find-last-index (lambda (it) ,form) ,list)) 871 | 872 | (defun -select-by-indices (indices list) 873 | "Return a list whose elements are elements from LIST selected 874 | as `(nth i list)` for all i from INDICES." 875 | (let (r) 876 | (--each indices 877 | (!cons (nth it list) r)) 878 | (nreverse r))) 879 | 880 | (defmacro -> (x &optional form &rest more) 881 | "Threads the expr through the forms. Inserts X as the second 882 | item in the first form, making a list of it if it is not a list 883 | already. If there are more forms, inserts the first form as the 884 | second item in second form, etc." 885 | (cond 886 | ((null form) x) 887 | ((null more) (if (listp form) 888 | `(,(car form) ,x ,@(cdr form)) 889 | (list form x))) 890 | (:else `(-> (-> ,x ,form) ,@more)))) 891 | 892 | (defmacro ->> (x form &rest more) 893 | "Threads the expr through the forms. Inserts X as the last item 894 | in the first form, making a list of it if it is not a list 895 | already. If there are more forms, inserts the first form as the 896 | last item in second form, etc." 897 | (if (null more) 898 | (if (listp form) 899 | `(,(car form) ,@(cdr form) ,x) 900 | (list form x)) 901 | `(->> (->> ,x ,form) ,@more))) 902 | 903 | (defmacro --> (x form &rest more) 904 | "Threads the expr through the forms. Inserts X at the position 905 | signified by the token `it' in the first form. If there are more 906 | forms, inserts the first form at the position signified by `it' 907 | in in second form, etc." 908 | (if (null more) 909 | (if (listp form) 910 | (--map-when (eq it 'it) x form) 911 | (list form x)) 912 | `(--> (--> ,x ,form) ,@more))) 913 | 914 | (put '-> 'lisp-indent-function 1) 915 | (put '->> 'lisp-indent-function 1) 916 | (put '--> 'lisp-indent-function 1) 917 | 918 | (defun -grade-up (comparator list) 919 | "Grades elements of LIST using COMPARATOR relation, yielding a 920 | permutation vector such that applying this permutation to LIST 921 | sorts it in ascending order." 922 | ;; ugly hack to "fix" lack of lexical scope 923 | (let ((comp `(lambda (it other) (funcall ',comparator (car it) (car other))))) 924 | (->> (--map-indexed (cons it it-index) list) 925 | (-sort comp) 926 | (-map 'cdr)))) 927 | 928 | (defun -grade-down (comparator list) 929 | "Grades elements of LIST using COMPARATOR relation, yielding a 930 | permutation vector such that applying this permutation to LIST 931 | sorts it in descending order." 932 | ;; ugly hack to "fix" lack of lexical scope 933 | (let ((comp `(lambda (it other) (funcall ',comparator (car other) (car it))))) 934 | (->> (--map-indexed (cons it it-index) list) 935 | (-sort comp) 936 | (-map 'cdr)))) 937 | 938 | (defmacro -when-let (var-val &rest body) 939 | "If VAL evaluates to non-nil, bind it to VAR and execute body. 940 | VAR-VAL should be a (VAR VAL) pair." 941 | (declare (debug ((symbolp form) body)) 942 | (indent 1)) 943 | (let ((var (car var-val)) 944 | (val (cadr var-val))) 945 | `(let ((,var ,val)) 946 | (when ,var 947 | ,@body)))) 948 | 949 | (defmacro -when-let* (vars-vals &rest body) 950 | "If all VALS evaluate to true, bind them to their corresponding 951 | VARS and execute body. VARS-VALS should be a list of (VAR VAL) 952 | pairs (corresponding to bindings of `let*')." 953 | (declare (debug ((&rest (symbolp form)) body)) 954 | (indent 1)) 955 | (if (= (length vars-vals) 1) 956 | `(-when-let ,(car vars-vals) 957 | ,@body) 958 | `(-when-let ,(car vars-vals) 959 | (-when-let* ,(cdr vars-vals) 960 | ,@body)))) 961 | 962 | (defmacro --when-let (val &rest body) 963 | "If VAL evaluates to non-nil, bind it to `it' and execute 964 | body." 965 | (declare (debug (form body)) 966 | (indent 1)) 967 | `(let ((it ,val)) 968 | (when it 969 | ,@body))) 970 | 971 | (defmacro -if-let (var-val then &rest else) 972 | "If VAL evaluates to non-nil, bind it to VAR and do THEN, 973 | otherwise do ELSE. VAR-VAL should be a (VAR VAL) pair." 974 | (declare (debug ((symbolp form) form body)) 975 | (indent 2)) 976 | (let ((var (car var-val)) 977 | (val (cadr var-val))) 978 | `(let ((,var ,val)) 979 | (if ,var ,then ,@else)))) 980 | 981 | (defmacro -if-let* (vars-vals then &rest else) 982 | "If all VALS evaluate to true, bind them to their corresponding 983 | VARS and do THEN, otherwise do ELSE. VARS-VALS should be a list 984 | of (VAR VAL) pairs (corresponding to the bindings of `let*')." 985 | (declare (debug ((&rest (symbolp form)) form body)) 986 | (indent 2)) 987 | (let ((first-pair (car vars-vals)) 988 | (rest (cdr vars-vals))) 989 | (if (= (length vars-vals) 1) 990 | `(-if-let ,first-pair ,then ,@else) 991 | `(-if-let ,first-pair 992 | (-if-let* ,rest ,then ,@else) 993 | ,@else)))) 994 | 995 | (defmacro --if-let (val then &rest else) 996 | "If VAL evaluates to non-nil, bind it to `it' and do THEN, 997 | otherwise do ELSE." 998 | (declare (debug (form form body)) 999 | (indent 2)) 1000 | `(let ((it ,val)) 1001 | (if it ,then ,@else))) 1002 | 1003 | (defun -distinct (list) 1004 | "Return a new list with all duplicates removed. 1005 | The test for equality is done with `equal', 1006 | or with `-compare-fn' if that's non-nil. 1007 | 1008 | Alias: `-uniq'" 1009 | (let (result) 1010 | (--each list (unless (-contains? result it) (!cons it result))) 1011 | (nreverse result))) 1012 | 1013 | (defun -union (list list2) 1014 | "Return a new list containing the elements of LIST1 and elements of LIST2 that are not in LIST1. 1015 | The test for equality is done with `equal', 1016 | or with `-compare-fn' if that's non-nil." 1017 | (let (result) 1018 | (--each list (!cons it result)) 1019 | (--each list2 (unless (-contains? result it) (!cons it result))) 1020 | (nreverse result))) 1021 | 1022 | (defalias '-uniq '-distinct) 1023 | 1024 | (defun -intersection (list list2) 1025 | "Return a new list containing only the elements that are members of both LIST and LIST2. 1026 | The test for equality is done with `equal', 1027 | or with `-compare-fn' if that's non-nil." 1028 | (--filter (-contains? list2 it) list)) 1029 | 1030 | (defun -difference (list list2) 1031 | "Return a new list with only the members of LIST that are not in LIST2. 1032 | The test for equality is done with `equal', 1033 | or with `-compare-fn' if that's non-nil." 1034 | (--filter (not (-contains? list2 it)) list)) 1035 | 1036 | (defvar -compare-fn nil 1037 | "Tests for equality use this function or `equal' if this is nil. 1038 | It should only be set using dynamic scope with a let, like: 1039 | (let ((-compare-fn =)) (-union numbers1 numbers2 numbers3)") 1040 | 1041 | (defun -contains? (list element) 1042 | "Return whether LIST contains ELEMENT. 1043 | The test for equality is done with `equal', 1044 | or with `-compare-fn' if that's non-nil." 1045 | (not 1046 | (null 1047 | (cond 1048 | ((null -compare-fn) (member element list)) 1049 | ((eq -compare-fn 'eq) (memq element list)) 1050 | ((eq -compare-fn 'eql) (memql element list)) 1051 | (t 1052 | (let ((lst list)) 1053 | (while (and lst 1054 | (not (funcall -compare-fn element (car lst)))) 1055 | (setq lst (cdr lst))) 1056 | lst)))))) 1057 | 1058 | (defalias '-contains-p '-contains?) 1059 | 1060 | (defun -same-items? (list list2) 1061 | "Return true if LIST and LIST2 has the same items. 1062 | 1063 | The order of the elements in the lists does not matter." 1064 | (let ((length-a (length list)) 1065 | (length-b (length list2))) 1066 | (and 1067 | (= length-a length-b) 1068 | (= length-a (length (-intersection list list2)))))) 1069 | 1070 | (defalias '-same-items-p '-same-items?) 1071 | 1072 | (defun -is-prefix-p (prefix list) 1073 | "Return non-nil if PREFIX is prefix of LIST." 1074 | (--each-while list (equal (car prefix) it) 1075 | (!cdr prefix)) 1076 | (not prefix)) 1077 | 1078 | (defun -is-suffix-p (suffix list) 1079 | "Return non-nil if SUFFIX is suffix of LIST." 1080 | (-is-prefix-p (nreverse suffix) (nreverse list))) 1081 | 1082 | (defun -is-infix-p (infix list) 1083 | "Return non-nil if INFIX is infix of LIST. 1084 | 1085 | This operation runs in O(n^2) time" 1086 | (let (done) 1087 | (while (and (not done) list) 1088 | (setq done (-is-prefix-p infix list)) 1089 | (!cdr list)) 1090 | done)) 1091 | 1092 | (defalias '-is-prefix? '-is-prefix-p) 1093 | (defalias '-is-suffix? '-is-suffix-p) 1094 | (defalias '-is-infix? '-is-infix-p) 1095 | 1096 | (defun -sort (comparator list) 1097 | "Sort LIST, stably, comparing elements using COMPARATOR. 1098 | Returns the sorted list. LIST is NOT modified by side effects. 1099 | COMPARATOR is called with two elements of LIST, and should return non-nil 1100 | if the first element should sort before the second." 1101 | (sort (copy-sequence list) comparator)) 1102 | 1103 | (defmacro --sort (form list) 1104 | "Anaphoric form of `-sort'." 1105 | (declare (debug (form form))) 1106 | `(-sort (lambda (it other) ,form) ,list)) 1107 | 1108 | (defun -list (&rest args) 1109 | "Return a list with ARGS. 1110 | 1111 | If first item of ARGS is already a list, simply return ARGS. If 1112 | not, return a list with ARGS as elements." 1113 | (let ((arg (car args))) 1114 | (if (listp arg) arg args))) 1115 | 1116 | (defun -repeat (n x) 1117 | "Return a list with X repeated N times. 1118 | Returns nil if N is less than 1." 1119 | (let (ret) 1120 | (--dotimes n (!cons x ret)) 1121 | ret)) 1122 | 1123 | (defun -sum (list) 1124 | "Return the sum of LIST." 1125 | (apply '+ list)) 1126 | 1127 | (defun -product (list) 1128 | "Return the product of LIST." 1129 | (apply '* list)) 1130 | 1131 | (defun -max (list) 1132 | "Return the largest value from LIST of numbers or markers." 1133 | (apply 'max list)) 1134 | 1135 | (defun -min (list) 1136 | "Return the smallest value from LIST of numbers or markers." 1137 | (apply 'min list)) 1138 | 1139 | (defun -max-by (comparator list) 1140 | "Take a comparison function COMPARATOR and a LIST and return 1141 | the greatest element of the list by the comparison function. 1142 | 1143 | See also combinator `-on' which can transform the values before 1144 | comparing them." 1145 | (--reduce (if (funcall comparator it acc) it acc) list)) 1146 | 1147 | (defun -min-by (comparator list) 1148 | "Take a comparison function COMPARATOR and a LIST and return 1149 | the least element of the list by the comparison function. 1150 | 1151 | See also combinator `-on' which can transform the values before 1152 | comparing them." 1153 | (--reduce (if (funcall comparator it acc) acc it) list)) 1154 | 1155 | (defmacro --max-by (form list) 1156 | "Anaphoric version of `-max-by'. 1157 | 1158 | The items for the comparator form are exposed as \"it\" and \"other\"." 1159 | (declare (debug (form form))) 1160 | `(-max-by (lambda (it other) ,form) ,list)) 1161 | 1162 | (defmacro --min-by (form list) 1163 | "Anaphoric version of `-min-by'. 1164 | 1165 | The items for the comparator form are exposed as \"it\" and \"other\"." 1166 | (declare (debug (form form))) 1167 | `(-min-by (lambda (it other) ,form) ,list)) 1168 | 1169 | (defun -iterate (fun init n) 1170 | "Return a list of iterated applications of FUN to INIT. 1171 | 1172 | This means a list of form: 1173 | '(init (fun init) (fun (fun init)) ...) 1174 | 1175 | N is the length of the returned list." 1176 | (if (= n 0) nil 1177 | (let ((r (list init))) 1178 | (--dotimes (1- n) 1179 | (push (funcall fun (car r)) r)) 1180 | (nreverse r)))) 1181 | 1182 | (defmacro --iterate (form init n) 1183 | "Anaphoric version of `-iterate'." 1184 | (declare (debug (form form form))) 1185 | `(-iterate (lambda (it) ,form) ,init ,n)) 1186 | 1187 | (defun -unfold (fun seed) 1188 | "Build a list from SEED using FUN. 1189 | 1190 | This is \"dual\" operation to `-reduce-r': while -reduce-r 1191 | consumes a list to produce a single value, `-unfold' takes a 1192 | seed value and builds a (potentially infinite!) list. 1193 | 1194 | FUN should return `nil' to stop the generating process, or a 1195 | cons (A . B), where A will be prepended to the result and B is 1196 | the new seed." 1197 | (let ((last (funcall fun seed)) r) 1198 | (while last 1199 | (push (car last) r) 1200 | (setq last (funcall fun (cdr last)))) 1201 | (nreverse r))) 1202 | 1203 | (defmacro --unfold (form seed) 1204 | "Anaphoric version of `-unfold'." 1205 | (declare (debug (form form))) 1206 | `(-unfold (lambda (it) ,form) ,seed)) 1207 | 1208 | (defun -cons-pair? (con) 1209 | "Return non-nil if CON is true cons pair. 1210 | That is (A . B) where B is not a list." 1211 | (and (listp con) 1212 | (not (listp (cdr con))))) 1213 | 1214 | (defun -cons-to-list (con) 1215 | "Convert a cons pair to a list with `car' and `cdr' of the pair respectively." 1216 | (list (car con) (cdr con))) 1217 | 1218 | (defun -value-to-list (val) 1219 | "Convert a value to a list. 1220 | 1221 | If the value is a cons pair, make a list with two elements, `car' 1222 | and `cdr' of the pair respectively. 1223 | 1224 | If the value is anything else, wrap it in a list." 1225 | (cond 1226 | ((-cons-pair? val) (-cons-to-list val)) 1227 | (t (list val)))) 1228 | 1229 | (defun -tree-mapreduce-from (fn folder init-value tree) 1230 | "Apply FN to each element of TREE, and make a list of the results. 1231 | If elements of TREE are lists themselves, apply FN recursively to 1232 | elements of these nested lists. 1233 | 1234 | Then reduce the resulting lists using FOLDER and initial value 1235 | INIT-VALUE. See `-reduce-r-from'. 1236 | 1237 | This is the same as calling `-tree-reduce-from' after `-tree-map' 1238 | but is twice as fast as it only traverse the structure once." 1239 | (cond 1240 | ((not tree) nil) 1241 | ((-cons-pair? tree) (funcall fn tree)) 1242 | ((listp tree) 1243 | (-reduce-r-from folder init-value (mapcar (lambda (x) (-tree-mapreduce-from fn folder init-value x)) tree))) 1244 | (t (funcall fn tree)))) 1245 | 1246 | (defmacro --tree-mapreduce-from (form folder init-value tree) 1247 | "Anaphoric form of `-tree-mapreduce-from'." 1248 | (declare (debug (form form form form))) 1249 | `(-tree-mapreduce-from (lambda (it) ,form) (lambda (it acc) ,folder) ,init-value ,tree)) 1250 | 1251 | (defun -tree-mapreduce (fn folder tree) 1252 | "Apply FN to each element of TREE, and make a list of the results. 1253 | If elements of TREE are lists themselves, apply FN recursively to 1254 | elements of these nested lists. 1255 | 1256 | Then reduce the resulting lists using FOLDER and initial value 1257 | INIT-VALUE. See `-reduce-r-from'. 1258 | 1259 | This is the same as calling `-tree-reduce' after `-tree-map' 1260 | but is twice as fast as it only traverse the structure once." 1261 | (cond 1262 | ((not tree) nil) 1263 | ((-cons-pair? tree) (funcall fn tree)) 1264 | ((listp tree) 1265 | (-reduce-r folder (mapcar (lambda (x) (-tree-mapreduce fn folder x)) tree))) 1266 | (t (funcall fn tree)))) 1267 | 1268 | (defmacro --tree-mapreduce (form folder tree) 1269 | "Anaphoric form of `-tree-mapreduce'." 1270 | (declare (debug (form form form))) 1271 | `(-tree-mapreduce (lambda (it) ,form) (lambda (it acc) ,folder) ,tree)) 1272 | 1273 | (defun -tree-map (fn tree) 1274 | "Apply FN to each element of TREE while preserving the tree structure." 1275 | (cond 1276 | ((not tree) nil) 1277 | ((-cons-pair? tree) (funcall fn tree)) 1278 | ((listp tree) 1279 | (mapcar (lambda (x) (-tree-map fn x)) tree)) 1280 | (t (funcall fn tree)))) 1281 | 1282 | (defmacro --tree-map (form tree) 1283 | "Anaphoric form of `-tree-map'." 1284 | (declare (debug (form form))) 1285 | `(-tree-map (lambda (it) ,form) ,tree)) 1286 | 1287 | (defun -tree-reduce-from (fn init-value tree) 1288 | "Use FN to reduce elements of list TREE. 1289 | If elements of TREE are lists themselves, apply the reduction recursively. 1290 | 1291 | FN is first applied to INIT-VALUE and first element of the list, 1292 | then on this result and second element from the list etc. 1293 | 1294 | The initial value is ignored on cons pairs as they always contain 1295 | two elements." 1296 | (cond 1297 | ((not tree) nil) 1298 | ((-cons-pair? tree) tree) 1299 | ((listp tree) 1300 | (-reduce-r-from fn init-value (mapcar (lambda (x) (-tree-reduce-from fn init-value x)) tree))) 1301 | (t tree))) 1302 | 1303 | (defmacro --tree-reduce-from (form init-value tree) 1304 | "Anaphoric form of `-tree-reduce-from'." 1305 | (declare (debug (form form form))) 1306 | `(-tree-reduce-from (lambda (it acc) ,form) ,init-value ,tree)) 1307 | 1308 | (defun -tree-reduce (fn tree) 1309 | "Use FN to reduce elements of list TREE. 1310 | If elements of TREE are lists themselves, apply the reduction recursively. 1311 | 1312 | FN is first applied to first element of the list and second 1313 | element, then on this result and third element from the list etc. 1314 | 1315 | See `-reduce-r' for how exactly are lists of zero or one element handled." 1316 | (cond 1317 | ((not tree) nil) 1318 | ((-cons-pair? tree) tree) 1319 | ((listp tree) 1320 | (-reduce-r fn (mapcar (lambda (x) (-tree-reduce fn x)) tree))) 1321 | (t tree))) 1322 | 1323 | (defmacro --tree-reduce (form tree) 1324 | "Anaphoric form of `-tree-reduce'." 1325 | (declare (debug (form form))) 1326 | `(-tree-reduce (lambda (it acc) ,form) ,tree)) 1327 | 1328 | (defun -clone (list) 1329 | "Create a deep copy of LIST. 1330 | The new list has the same elements and structure but all cons are 1331 | replaced with new ones. This is useful when you need to clone a 1332 | structure such as plist or alist." 1333 | (-tree-map 'identity list)) 1334 | 1335 | (defun dash-enable-font-lock () 1336 | "Add syntax highlighting to dash functions, macros and magic values." 1337 | (eval-after-load "lisp-mode" 1338 | '(progn 1339 | (let ((new-keywords '( 1340 | "-each" 1341 | "--each" 1342 | "-each-while" 1343 | "--each-while" 1344 | "-dotimes" 1345 | "--dotimes" 1346 | "-map" 1347 | "--map" 1348 | "-reduce-from" 1349 | "--reduce-from" 1350 | "-reduce" 1351 | "--reduce" 1352 | "-reduce-r-from" 1353 | "--reduce-r-from" 1354 | "-reduce-r" 1355 | "--reduce-r" 1356 | "-filter" 1357 | "--filter" 1358 | "-select" 1359 | "--select" 1360 | "-remove" 1361 | "--remove" 1362 | "-reject" 1363 | "--reject" 1364 | "-keep" 1365 | "--keep" 1366 | "-map-indexed" 1367 | "--map-indexed" 1368 | "-map-when" 1369 | "--map-when" 1370 | "-replace-where" 1371 | "--replace-where" 1372 | "-flatten" 1373 | "-concat" 1374 | "-mapcat" 1375 | "--mapcat" 1376 | "-cons*" 1377 | "-snoc" 1378 | "-first" 1379 | "--first" 1380 | "-last" 1381 | "--last" 1382 | "-first-item" 1383 | "-last-item" 1384 | "-count" 1385 | "--count" 1386 | "-any?" 1387 | "--any?" 1388 | "-some?" 1389 | "--some?" 1390 | "-any-p" 1391 | "--any-p" 1392 | "-some-p" 1393 | "--some-p" 1394 | "-all?" 1395 | "--all?" 1396 | "-every?" 1397 | "--every?" 1398 | "-all-p" 1399 | "--all-p" 1400 | "-every-p" 1401 | "--every-p" 1402 | "-none?" 1403 | "--none?" 1404 | "-none-p" 1405 | "--none-p" 1406 | "-only-some?" 1407 | "--only-some?" 1408 | "-only-some-p" 1409 | "--only-some-p" 1410 | "-slice" 1411 | "-take" 1412 | "-drop" 1413 | "-take-while" 1414 | "--take-while" 1415 | "-drop-while" 1416 | "--drop-while" 1417 | "-split-at" 1418 | "-rotate" 1419 | "-insert-at" 1420 | "-replace-at" 1421 | "-update-at" 1422 | "--update-at" 1423 | "-remove-at" 1424 | "-remove-at-indices" 1425 | "-split-with" 1426 | "--split-with" 1427 | "-split-on" 1428 | "-split-when" 1429 | "--split-when" 1430 | "-separate" 1431 | "--separate" 1432 | "-partition-all-in-steps" 1433 | "-partition-in-steps" 1434 | "-partition-all" 1435 | "-partition" 1436 | "-partition-by" 1437 | "--partition-by" 1438 | "-partition-by-header" 1439 | "--partition-by-header" 1440 | "-group-by" 1441 | "--group-by" 1442 | "-interpose" 1443 | "-interleave" 1444 | "-zip-with" 1445 | "--zip-with" 1446 | "-zip" 1447 | "-partial" 1448 | "-elem-index" 1449 | "-elem-indices" 1450 | "-find-indices" 1451 | "--find-indices" 1452 | "-find-index" 1453 | "--find-index" 1454 | "-find-last-index" 1455 | "--find-last-index" 1456 | "-select-by-indices" 1457 | "-grade-up" 1458 | "-grade-down" 1459 | "->" 1460 | "->>" 1461 | "-->" 1462 | "-when-let" 1463 | "-when-let*" 1464 | "--when-let" 1465 | "-if-let" 1466 | "-if-let*" 1467 | "--if-let" 1468 | "-distinct" 1469 | "-uniq" 1470 | "-union" 1471 | "-intersection" 1472 | "-difference" 1473 | "-contains?" 1474 | "-contains-p" 1475 | "-same-items?" 1476 | "-same-items-p" 1477 | "-is-prefix-p" 1478 | "-is-prefix?" 1479 | "-is-suffix-p" 1480 | "-is-suffix?" 1481 | "-is-infix-p" 1482 | "-is-infix?" 1483 | "-sort" 1484 | "--sort" 1485 | "-list" 1486 | "-repeat" 1487 | "-sum" 1488 | "-product" 1489 | "-max" 1490 | "-min" 1491 | "-max-by" 1492 | "--max-by" 1493 | "-min-by" 1494 | "--min-by" 1495 | "-iterate" 1496 | "--iterate" 1497 | "-unfold" 1498 | "--unfold" 1499 | "-cons-pair?" 1500 | "-cons-to-list" 1501 | "-value-to-list" 1502 | "-tree-mapreduce-from" 1503 | "--tree-mapreduce-from" 1504 | "-tree-mapreduce" 1505 | "--tree-mapreduce" 1506 | "-tree-map" 1507 | "--tree-map" 1508 | "-tree-reduce-from" 1509 | "--tree-reduce-from" 1510 | "-tree-reduce" 1511 | "--tree-reduce" 1512 | "-clone" 1513 | "-rpartial" 1514 | "-juxt" 1515 | "-applify" 1516 | "-on" 1517 | "-flip" 1518 | "-const" 1519 | "-cut" 1520 | "-orfn" 1521 | "-andfn" 1522 | )) 1523 | (special-variables '( 1524 | "it" 1525 | "it-index" 1526 | "acc" 1527 | "other" 1528 | ))) 1529 | (font-lock-add-keywords 'emacs-lisp-mode `((,(concat "\\_<" (regexp-opt special-variables 'paren) "\\_>") 1530 | 1 font-lock-variable-name-face)) 'append) 1531 | (font-lock-add-keywords 'emacs-lisp-mode `((,(concat "(\\s-*" (regexp-opt new-keywords 'paren) "\\_>") 1532 | 1 font-lock-keyword-face)) 'append)) 1533 | (--each (buffer-list) 1534 | (with-current-buffer it 1535 | (when (and (eq major-mode 'emacs-lisp-mode) 1536 | (boundp 'font-lock-mode) 1537 | font-lock-mode) 1538 | (font-lock-refresh-defaults))))))) 1539 | 1540 | (provide 'dash) 1541 | ;;; dash.el ends here 1542 | --------------------------------------------------------------------------------