[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/repology afe973b 3/4: * repology.el: Keep free packages
|
From: |
Stefan Monnier |
|
Subject: |
[elpa] externals/repology afe973b 3/4: * repology.el: Keep free packages rather than weed out non-free ones |
|
Date: |
Sat, 16 Jan 2021 16:01:13 -0500 (EST) |
branch: externals/repology
commit afe973b703f3a702169b99389745241c26cb2c72
Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>
* repology.el: Keep free packages rather than weed out non-free ones
(repology-free-only-projects): Rename from
`repology-ignore-non-free-projects`.
(repology-non-free-licenses-regexps): Remove variable.
(repology--request): Don't unhex the body. Append properties rather
than nesting them within a `status` property.
(repology--get, repology-list-repositories): Simplify accordingly.
(repology-lookup-project): Rename from `repology-project-lookup`.
(repology-search-projects): Rename from `repology-projects-search`.
Use `repology-free-p`.
(repology-report-problems): Rename from `repology-repository-problems`.
* repology-license.el: New file.
---
repology-license.el | 359 ++++++++++++++++++++++++++++++++++++++++++++++++++++
repology.el | 118 ++++++-----------
2 files changed, 397 insertions(+), 80 deletions(-)
diff --git a/repology-license.el b/repology-license.el
new file mode 100644
index 0000000..5e76f63
--- /dev/null
+++ b/repology-license.el
@@ -0,0 +1,359 @@
+;;; repology-license.el --- Freedom check for Repology -*- lexical-binding:
t; -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This library provides the `repology-free-p' function, which returns
+;; a non-nil value when a package or a project can be considered as
+;; free.
+
+;; The decision is made by polling a number of "Reference
+;; repositories", defined in `repology-license-reference-repositories'.
+;; If the ratio of "Free" votes is equal or above
+;; `repology-license-poll-threshold', the project is declared as free.
+
+;; In order to see the results of each vote, and possibly debug the
+;; process, you can set `repology-license-debug' to a non-nil value.
+
+
+;;; Constants
+(defconst repology-license-reference-repositories
+ '(("debian" "main" t)
+ ("debian" "contrib" t)
+ ("gnuguix" nil t)
+ ("hyperbola" nil t)
+ ("parabola" nil t)
+ ("pureos" nil t)
+ ("trisquel" nil t)
+ ("gnu_elpa" nil t)
+ ("^fedora" nil repology--license-check:fedora)
+ ("^gentoo" nil repology--license-check:gentoo)
+ ("^opensuse" "/oss" repology--license-check:opensuse-oss)
+ ("debian" "non-free" nil)
+ ("^opensuse" "/non-oss" nil))
+ "List of repositories providing a reliable license information.
+
+This is a list of triplets (REPO SUBREPO PREDICATE) where:
+
+ REPO is a regexp matching the internal name of a repository;
+ SUBREPO is a regexp matching a sub-repository or nil;
+ PREDICATE is either a boolean or a function called with one string argument.
+
+When PREDICATE is a function, it must return a non-nil value if the argument
+is a free license according to the repository. If PREDICATE is t, we trust
+the repository to provide only free software. Conversely, PREDICATE is nil
+when the repository is known to reference only non-free software.
+
+A repository with a PREDICATE function is expected to have the following
+properties:
+- it audits carefully the licenses it reports;
+- it uses a consistent, and documented, license syntax;
+- Repology properly fetches the licenses of its packages.
+ See URL `https://repology.org/repositories/fields'.")
+
+(defconst repology-license-poll-threshold 0.5
+ "Ratio of votes above which a package is declared to be free.")
+
+
+;;; Tools
+(defun repology--license-interpret-vote (free votes)
+ "Return freedom vote result as a boolean.
+FREE is the number of \"Free\" votes. VOTES is the total number of votes."
+ (and (> votes 0)
+ (>= (/ (float free) votes) repology-license-poll-threshold)))
+
+
+;;; Reference Repository: Fedora
+(defun repology--license-check:fedora (license)
+ "Return a non-nil value if LICENSE is free, according to Fedora.
+See URL \
+`https://docs.fedoraproject.org/en-US/packaging-guidelines/LicensingGuidelines/'"
+ (let ((case-fold-search t)
+ ;; Anything in Fedora is free, unless its license contains the
+ ;; following.
+ (non-free-license-re
+ (rx word-start "Redistributable, no modification permitted"
word-end)))
+ (not (string-match non-free-license-re license))))
+
+
+;;; Reference Repository: Gentoo
+(defconst repology--license-identifiers:gentoo
+ (list
+ ;; GPL-COMPATIBLE
+ "AGPL-3" "AGPL-3+" "Apache-2.0" "Apache-2.0-with-LLVM-exceptions"
+ "Artistic-2" "Boost-1.0" "BSD" "BSD-2" "CC0-1.0" "CeCILL-2"
+ "Clarified-Artistic" "Clear-BSD" "ECL-2.0" "FTL"
+ "gcc-runtime-library-exception-3.1" "GPL-1" "GPL-1+" "GPL-2" "GPL-2+"
"GPL-3"
+ "GPL-3+" "GPL-2-with-classpath-exception" "GPL-2-with-exceptions"
+ "GPL-2-with-font-exception" "GPL-2-with-linking-exception"
+ "GPL-2-with-MySQL-FLOSS-exception" "GPL-2+-with-openssl-exception"
+ "GPL-3+-with-cuda-exception" "GPL-3+-with-cuda-openssl-exception"
+ "GPL-3-with-font-exception" "GPL-3+-with-opencl-exception"
+ "GPL-3+-with-opencl-openssl-exception" "GPL-3-with-openssl-exception"
+ "Transmission-OpenSSL-exception" "UPX-exception" "HPND" "IJG" "ISC" "LGPL-2"
+ "LGPL-2+" "LGPL-2.1" "LGPL-2.1+" "LGPL-3" "LGPL-3+"
+ "LGPL-2-with-linking-exception" "LGPL-2.1-with-linking-exception"
+ "LGPL-3-with-linking-exception" "Nokia-Qt-LGPL-Exception-1.1" "libgcc"
+ "libstdc++" "metapackage" "MIT" "MPL-2.0" "OPENLDAP" "PSF-2" "PSF-2.2"
+ "PSF-2.3" "PSF-2.4" "public-domain" "PYTHON" "qwt" "Ruby" "Ruby-BSD"
+ "SGI-B-2.0" "Sleepycat" "tanuki-community" "unicode" "Unlicense" "UoI-NCSA"
+ "vim" "W3C" "WTFPL-2" "wxWinLL-3.1" "ZLIB" "ZPL"
+ ;; FSF-APPROVED
+ "AFL-2.1" "AFL-3.0" "Apache-1.0" "Apache-1.1" "APSL-2" "BSD-4" "CDDL" "CNRI"
+ "CPAL-1.0" "CPL-1.0" "EPL-1.0" "EPL-2.0" "EUPL-1.1" "gnuplot" "IBM"
+ "LPPL-1.2" "MPL-1.0" "MPL-1.1" "Ms-PL" "NPL-1.1" "openssl" "OSL-1.1"
+ "OSL-2.0" "OSL-2.1" "PHP-3.01" "QPL" "QPL-1.0" "Zend-2.0"
+ ;; OSI-APPROVED
+ "AFL-3.0" "AGPL-3" "AGPL-3" "Apache-1.1" "Apache-2.0" "APL-1.0" "APSL-2"
+ "Artistic" "Artistic-2" "Boost-1.0" "BSD" "BSD-2" "CDDL" "CNRI" "CPAL-1.0"
+ "CPL-1.0" "ECL-2.0" "EPL-1.0" "EPL-2.0" "EUPL-1.1" "GPL-1" "GPL-2" "GPL-2"
+ "GPL-3" "GPL-3" "HPND" "IBM" "IPAfont" "ISC" "LGPL-2" "LGPL-2.1" "LGPL-2.1"
+ "LGPL-3" "LGPL-3" "LPPL-1.3c" "MIT" "MPL-1.0" "MPL-1.1" "MPL-2.0" "Ms-PL"
+ "nethack" "NOSA" "OFL-1.1" "OSL-2.1" "PHP-3" "PHP-3.01" "POSTGRESQL"
"PSF-2"
+ "QPL" "Sleepycat" "UoI-NCSA" "W3C" "Watcom-1.0" "wxWinLL-3" "ZLIB" "ZPL"
+ ;; MISC-FREE
+ "Allegro" "alternate" "AMPAS" "bea.ri.jsr173" "BEER-WARE" "boehm-gc" "BSD-1"
+ "BSD-with-attribution" "BSD-with-disclosure" "buddy" "bufexplorer.vim"
+ "BZIP2" "canfep" "CAOSL" "CDDL-Schily" "CeCILL-C" "CLX" "CMake" "CPL-0.5"
+ "CRACKLIB" "Crypt-IDEA" "DES" "docbook" "dom4j" "DUMB-0.9.3"
+ "eGenixPublic-1.1" "ElementTree" "Emacs" "ErlPL-1.1" "FastCGI" "feh"
+ "File-MMagic" "Flashpix" "FLEX" "flexmock" "FLTK" "freetts" "FVWM" "gd"
+ "gsm" "HTML-Tidy" "htmlc" "iASL" "icu" "IDPL" "imagemagick" "Info-ZIP"
+ "inner-net" "Interbase-1.0" "ipadic" "ipx-utils" "Ispell" "JasPer2.0" "JDOM"
+ "JNIC" "JOVE" "Khronos-CLHPP" "LambdaMOO" "LIBGLOSS" "libmng" "libpng"
+ "libpng2" "libtiff" "LLVM-Grant" "LPPL-1.3" "LPPL-1.3b" "lsof"
+ "Mail-Sendmail" "mapm-4.9.5" "matplotlib" "Mini-XML" "minpack"
+ "MIT-with-advertising" "mm" "mpich2" "NCSA-HDF" "netcat" "NEWLIB" "ngrep"
+ "Old-MIT" "openafs-krb5-a" "Openwall" "otter" "PCRE" "perforce" "photopc"
+ "PHP-2.02" "pngcrush" "pngnq" "Princeton" "psutils" "qmail-nelson" "rc"
+ "rdisc" "regexp-UofT" "repoze" "RSA" "rwpng" "scanlogd" "Sendmail"
+ "Sendmail-Open-Source" "shrimp" "SMAIL" "Snd" "SNIA" "SSLeay" "Subversion"
+ "SVFL" "symlinks" "tablelist" "tcltk" "tcp_wrappers_license" "TeX"
+ "TeX-other-free" "the-Click-license" "Time-Format" "Time-modules" "tm-align"
+ "torque-2.5" "totd" "Toyoda" "UCAR-Unidata" "URT" "VTK" "w3m" "x2x" "xbatt"
+ "xboing" "XC" "Xdebug" "xtrs" "xvt" "YaTeX" "yuuji" "ZSH"
+ ;; FSF-APPROVED-OTHER.
+ "Arphic" "CC-BY-2.0" "CC-BY-2.5" "CC-BY-3.0" "CC-BY-4.0" "CC-BY-SA-2.0"
+ "CC-BY-SA-2.5" "CC-BY-SA-3.0" "CC-BY-SA-4.0" "FDL-1.1" "FDL-1.1+" "FDL-1.2"
+ "FDL-1.2+" "FDL-1.3" "FDL-1.3+" "FreeArt" "GPL-1" "GPL-1+" "GPL-2" "GPL-2+"
+ "GPL-3" "GPL-3+" "IPAfont" "OFL" "OFL-1.1" "OPL"
+ ;; MISC-FREE-DOCS.
+ "BitstreamVera" "CC-PD" "CC-BY-SA-1.0" "CC-SA-1.0" "LDP-1" "LDP-1a"
+ "man-pages" "man-pages-posix" "man-pages-posix-2013" "MaxMind2"
"mplus-fonts"
+ "myspell-en_CA-KevinAtkinson" "quake1-textures" "Texinfo-manual"
+ "UbuntuFontLicense-1.0" "Unicode_Fonts_for_Ancient_Scripts" "vlgothic"
+ "wxWinFDL-3")
+ "List of identifiers considered as free licenses by Gentoo
+See URL `https://wiki.gentoo.org/wiki/License_groups'.")
+
+(defun repology--license-gentoo:skip-whitespace ()
+ "Skip past the whitespace at point."
+ (skip-chars-forward " \t"))
+
+(defun repology--license-gentoo:skip-non-whitespace ()
+ "Skip past the whitespace at point."
+ (skip-chars-forward "^ \t"))
+
+(defun repology--license-gentoo:advance (&optional n)
+ "Advance N characters forward."
+ (forward-char n))
+
+(defun repology--license-gentoo:peek (&optional n)
+ "Advance N characters forward."
+ (following-char))
+
+(defun repology--license-gentoo:and ()
+ "Return license freedom for the \"and\" construct at point."
+ ;; Skip past "(" token.
+ (repology--license-gentoo:advance 1)
+ (repology--license-gentoo:skip-whitespace)
+ (let ((value t))
+ (while (/= (repology--license-gentoo:peek) ?\))
+ (repology--license-gentoo:skip-whitespace)
+ (unless (repology--license-gentoo:read-next)
+ (setq value nil)))
+ ;; Skip past ")" character, and to next token.
+ (repology--license-gentoo:advance 1)
+ (repology--license-gentoo:skip-whitespace)
+ value))
+
+(defun repology--license-gentoo:or ()
+ "Return license freedom for the \"or\" construct at point."
+ ;; Skip past "|| (" token.
+ (repology--license-gentoo:advance 4)
+ (repology--license-gentoo:skip-whitespace)
+ (let ((value nil))
+ (while (/= (repology--license-gentoo:peek) ?\))
+ (when (repology--license-gentoo:read-next)
+ (setq value t)))
+ ;; Skip past ")" character, and to next token.
+ (repology--license-gentoo:advance 1)
+ (repology--license-gentoo:skip-whitespace)
+ value))
+
+(defun repology--license-gentoo:identifier ()
+ "Return freedom of the license identifier at point."
+ (let ((origin (point)))
+ (repology--license-gentoo:skip-non-whitespace)
+ (let ((value (member-ignore-case (buffer-substring origin (point))
+ repology--license-identifiers:gentoo)))
+ (repology--license-gentoo:skip-whitespace)
+ value)))
+
+(defun repology--license-gentoo:parameter ()
+ "Assume parameter at point is set, and return license freedom accordingly."
+ ;; Skip past parameter.
+ (repology--license-gentoo:skip-non-whitespace)
+ (repology--license-gentoo:skip-whitespace)
+ (repology--license-gentoo:and))
+
+(defun repology--license-gentoo:read-next ()
+ "Return license freedom for next token, and move point past it."
+ (let ((parameter-re (rx (opt "!") (one-or-more (any alnum "-" "_")) "?")))
+ (pcase (repology--license-gentoo:peek)
+ (?\| (repology--license-gentoo:or))
+ (?\( (repology--license-gentoo:and))
+ ((guard (looking-at parameter-re))
+ (repology--license-gentoo:parameter))
+ (_
+ (repology--license-gentoo:identifier)))))
+
+(defun repology--license-check:gentoo (license)
+ "Return a non-nil value if LICENSE is free, according to Gentoo."
+ (with-temp-buffer
+ (insert license)
+ (goto-char 1)
+ (repology--license-gentoo:skip-whitespace)
+ (let ((value (not (eobp)))) ;blank string check
+ (while (and value (/= (repology--license-gentoo:peek) 0))
+ (unless (repology--license-gentoo:read-next)
+ (setq value nil)))
+ value)))
+
+
+;;; Reference Repository: OpenSUSE (OSS)
+(defun repology--license-check:opensuse-oss (license)
+ "Return a non-nil value if LICENSE is free, according to OpenSUSE (OSS).
+See URL `https://en.opensuse.org/openSUSE:Packaging_guidelines#Licensing'."
+ (let ((case-fold-search t)
+ ;; Anything in Fedora is free, unless its license contains the
+ ;; following.
+ (non-free-license-re
+ (rx word-start "SUSE-Firmware" word-end)))
+ (not (string-match non-free-license-re license))))
+
+
+;;; License Check Debugging
+(defvar repology-license-debug nil
+ "When non-nil, display explanations when a project declared non-free.
+Information is displayed in \"*Repology: License Debug*\" buffer.")
+
+(defun repology--license-debug-line (package free)
+ "Format license debug information for PACKAGE.
+When FREE is non-nil, declare PACKAGE was reported as free."
+ (let ((repo (repology-package-field package 'repo))
+ (subrepo (repology-package-field package 'subrepo))
+ (name (repology-package-field package 'visiblename)))
+ (format "%s (%s%s) => %s\n"
+ name
+ repo
+ (if subrepo (concat "/" subrepo) "")
+ (if free "Free" "Non-Free"))))
+
+(defun repology--license-debug-display (project reports free votes)
+ "Print license check output for non-free PROJECT.
+REPORTS is a list of strings, as returned by `repology--license-debug-line'.
+FREE is the number of free packages in PROJECT. VOTES is the number of
packages
+from reference repositories in PROJECT."
+ (with-current-buffer (get-buffer-create "*Repology: License Debug*")
+ (insert (format "=== Project %S: %s (ratio: %.2f) ===\n"
+ (repology-project-name project)
+ (if (repology--license-interpret-vote free votes)
+ "FREE"
+ "NON-FREE")
+ (if (= votes 0)
+ 0
+ (/ (float free) votes))))
+ (apply #'insert reports)
+ (insert "\n")))
+
+
+;;; Main Function
+(defun repology--license-find-reference-repository (package)
+ "Return the reference repository containing PACKAGE, or nil.
+Return value is a triplet per `repology-license-reference-repositories'."
+ (let ((repo (repology-package-field package 'repo))
+ (subrepo (repology-package-field package 'subrepo)))
+ (seq-find (pcase-lambda (`(,r ,s ,_))
+ (and (string-match r repo)
+ (or (not s)
+ (and subrepo (string-match s subrepo)))))
+ repology-license-reference-repositories)))
+
+(defun repology--license-free-p (package &optional repository)
+ "Return a non-nil value when PACKAGE is free.
+A package is free when any reference repository can attest it uses only free
+licenses. When optional argument REPOSITORY is non-nil, use it as a
reference."
+ (pcase (or repository (repology--license-find-reference-repository package))
+ ('nil nil)
+ (`(,_ ,_ ,(and (pred functionp) p))
+ (seq-every-p p (repology-package-field package 'licenses)))
+ (`(,_ ,_ ,boolean) boolean)
+ (other (error "Wrong repository definition: %S" other))))
+
+(defun repology-free-p (datum)
+ "Return a non-nil value when DATUM is free.
+
+DATUM is a project or a package.
+
+A package is free when any reference repository can attest it uses only free
+licenses. See `repology-license-reference-repositories' for a list of such
+repositories.
+
+A project is free if the ratio of free packages among the packages from
+reference repositories is above `repology-license-poll-threshold'.
+A project without any package from these repositories is declared as non-free.
+
+Of course, it is not a legal statement, merely an indicator."
+ (pcase datum
+ ((pred repology-package-p) (repology--license-free-p datum))
+ ((pred repology-project-p)
+ (let ((votes 0)
+ (yes 0)
+ (reports nil)
+ (voters nil))
+ (dolist (package (repology-project-packages datum))
+ (pcase (repology--license-find-reference-repository package)
+ ('nil nil)
+ (repository
+ (unless (member repository voters)
+ (cl-incf votes)
+ (push repository voters) ;a repository votes only once
+ (let ((free (repology--license-free-p package repository)))
+ (when free (cl-incf yes))
+ (when repology-license-debug
+ (push (repology--license-debug-line package free)
+ reports)))))))
+ ;; Maybe display vote reports as debugging information.
+ (when repology-license-debug
+ (repology--license-debug-display datum reports yes votes))
+ ;; Return value.
+ (repology--license-interpret-vote yes votes)))
+ (_ (user-error "Wrong argument type: %S" datum))))
+
+(provide 'repology-license)
+;;; repology-license.el ends here
diff --git a/repology.el b/repology.el
index 38c7033..1df64e4 100644
--- a/repology.el
+++ b/repology.el
@@ -6,7 +6,7 @@
;; Maintainer: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; Keywords: web
;; Package-Requires: ((emacs "26.1"))
-;; Version: 0.10
+;; Version: 0
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
@@ -29,14 +29,14 @@
;; The results of a query revolve around three types of objects:
;; projects, packages and problems. Using this library, you can find
;; projects matching certain criteria, packages in a given project,
-;; and possible problems in some repository. See `repology-projects-search',
-;; `repology-project-lookup', and `repology-repository-problems'.
+;; and possible problems in some repository. See `repology-search-projects',
+;; `repology-lookup-project', and `repology-report-problems'.
;; Projects-related requests are limited to `repology-projects-limit'.
;; All requests are cached during `repology-cache-duration' seconds.
;;
;; By default, projects including packages with a known non-free license
;; are not included in the search results. You can control this behavior
-;; with the variable `repology-ignore-non-free-projects'.
+;; with the variable `repology-free-only-projects'.
;; You can then access data from those various objects using dedicated
;; accessors. See, for example, `repology-project-name',
@@ -61,7 +61,7 @@
;; (seq-filter (lambda (project)
;; (not (member (repology-project-name project)
;; my-ignored-projects)))
-;; (repology-projects-search
+;; (repology-search-projects
;; :search "emacs" :inrepo "gnuguix" :outdated "on")))
;; Eventually, this library provides an interactive function with
@@ -84,6 +84,8 @@
(require 'tabulated-list)
(require 'url)
+(require 'repology-license)
+
;;; Macros
;; XXX: It is a macro because we need it to be available in defcustoms.
@@ -177,29 +179,14 @@ Repology claims to update its repository hourly.
A value of 0 prevents any caching."
:type 'integer)
-(defcustom repology-ignore-non-free-projects t
- "When non-nil, ignore projects with a non-free license from searches.
-
-See `repology-non-free-licenses-regexps' for information about how a project
-is assumed to be non-free.
+(defcustom repology-free-only-projects t
+ "When non-nil, return only free projects from searches.
-Projects with missing or erroneous licensing information may still be
displayed.
-Use your judgement!"
+Declaring a project as free the consequence of a very conservative process.
+Free projects with missing licensing information, or too confidential, may be
+ignored. See `repology-free-p' for more information."
:type 'boolean)
-(defcustom repology-non-free-licenses-regexps
- '("commercial" "freeware" "google-chrome" "no modification permitted"
- "microsoft" "nonfree" "proprietary" "restrictive" "skype" "unfree"
- "valvesteamlicense")
- "List of licenses field regexps known to match non-free licenses.
-
-Any project containing at least one package with a license matching one of
these
-regexps is considered to be non-free. Case is ignored.
-
-Feel free to contact the maintainer of this library to suggest additional
-default regexps."
- :type '(repeat regexp))
-
(defcustom repology-status-faces
'(("incorrect" . error)
("newest" . highlight)
@@ -442,10 +429,8 @@ the request."
(forward-line))
(forward-line)
(unless (eobp)
- (setq body
- (url-unhex-string
- (buffer-substring (point) (point-max)))))
- (list :status status :header (nreverse header) :body body)))
+ (setq body (buffer-substring (point) (point-max))))
+ (append status (list :header (nreverse header) :body body))))
(kill-buffer process-buffer))))
(defun repology--get (action value start)
@@ -460,7 +445,7 @@ Information is returned as parsed JSON."
(let ((request (repology--request
(repology--build-url action value start)
'(("Content-Type" . "application/json")))))
- (pcase (plist-get (plist-get request :status) :reason)
+ (pcase (plist-get request :reason)
("OK"
(let ((body (repology--parse-json (plist-get request :body))))
(repology--cache-put key body)
@@ -870,7 +855,7 @@ Return a list of strings. When option argument FULL-NAME
is non-nil, list
the repositories with their full name instead of their internal name."
(unless repology--repositories
(let ((request (repology--request repology-statistics-url)))
- (pcase (plist-get (plist-get request :status) :reason)
+ (pcase (plist-get request :reason)
("OK"
(let ((body (plist-get request :body))
(repositories nil)
@@ -953,37 +938,14 @@ See URL
`https://github.com/repology/libversion/blob/master/doc/ALGORITHM.md'."
;; Strings S1 and S2 represent equal versions.
nil)))
-(defun repology-non-free-p (datum)
- "Return a non-nil value when DATUM is non-free.
-
-DATUM is a project or a package. A package is non-free when one of its
licenses
-is recognized as non-free. A project is non-free when at least one of its
-packages is non-free. See `repology-non-free-licenses-regexps' for a list of
-regexps known to match non-free licenses."
- (let ((case-fold-search t))
- ;; Non-nil whenever one of the packages in the list...
- (seq-some (lambda (package)
- ;; ... contains at least one license...
- (seq-some (lambda (license)
- (message "License: %s" license)
- ;; ... matching a non-free license regexp.
- (seq-some (lambda (regexp)
- (string-match regexp license))
- repology-non-free-licenses-regexps))
- (repology-package-field package 'licenses)))
- (pcase datum
- ((pred repology-project-p) (repology-project-packages datum))
- ((pred repology-package-p) (list datum))
- (_ (user-error "Wrong argument type: %S" datum))))))
-
;;; Search functions
-(defun repology-project-lookup (name)
+(defun repology-lookup-project (name)
"List packages for project NAME.
NAME is a string. Return a list of packages."
(repology--get 'project name nil))
-(defun repology-projects-search (&rest filters)
+(defun repology-search-projects (&rest filters)
"Retrieve results of an advanced search in Repology.
FILTERS helps refining the search with the following keywords:
@@ -1036,18 +998,13 @@ FILTERS helps refining the search with the following
keywords:
return projects which have related ones (may require merging)
Return a list of projects. Projects with a known non-free license are removed
-from output, unless `repology-ignore-non-free-projects' is nil."
+from output, unless `repology-free-only-projects' is nil."
(let ((result nil)
(name nil))
(catch :exit
(while t
(let ((request (repology--get 'projects filters name)))
- ;; If we are resuming a previous search, drop the first
- ;; match since it was also the last match in the previous
- ;; search.
- (setq result (if result
- (append result (cdr request))
- request))
+ (setq result (append result (cdr request)))
(cond
;; Too many matches: drop those above limit and exit.
((<= repology-projects-limit (length result))
@@ -1056,20 +1013,21 @@ from output, unless `repology-ignore-non-free-projects'
is nil."
;; Matches exhausted: exit and return result.
((> repology-projects-hard-limit (length request))
(throw :exit result))
- ;; Resume search starting from the last project found.
+ ;; Resume search starting from an imaginary project located
+ ;; right after the last project found, alphabetically.
(t
(setq name
(pcase (last request)
(`(,(and (pred repology-project-p) project))
- (repology-project-name project))
+ (concat (repology-project-name project) "-"))
(other (error "Invalid request result: %S" other)))))))))
;; Trim non-free projects.
- (if (not repology-ignore-non-free-projects)
+ (if (not repology-free-only-projects)
result
- (seq-filter (lambda (project) (not (repology-non-free-p project)))
+ (seq-filter (lambda (project) (repology-free-p project))
result))))
-(defun repology-repository-problems (repository)
+(defun repology-report-problems (repository)
"List problems related to REPOSITORY.
REPOSITORY is a string. Return a list of problems."
(unless (member repository (repology-list-repositories))
@@ -1116,7 +1074,7 @@ or nil. This is the default value for
`repology-display-projects-columns'."
(defun repology-display-packages (packages)
"Display PACKAGES as a tabulated list.
-PACKAGES is a list of packages, as returned by `repology-project-lookup'.
+PACKAGES is a list of packages, as returned by `repology-lookup-project'.
Columns are displayed according to `repology-display-packages-columns'."
(repology--make-display packages
"*Repology Packages*"
@@ -1126,7 +1084,7 @@ Columns are displayed according to
`repology-display-packages-columns'."
(defun repology-display-projects (projects &optional selected)
"Display PROJECTS as a tabulated list.
-PROJECTS is a list of projects, as returned by `repology-projects-search'.
+PROJECTS is a list of projects, as returned by `repology-search-projects'.
Optional argument SELECTED, when non-nil, is the name of a repository to which
all projects are related.
@@ -1142,7 +1100,7 @@ Columns are displayed according to
`repology-display-projects-columns'."
(defun repology-display-problems (problems)
"Display PROBLEMS as a tabulated list.
-PROBLEMS is a list of problems, as returned by `repology-repository-problems'.
+PROBLEMS is a list of problems, as returned by `repology-report-problems'.
Columns are displayed according to `repology-display-problems-columns'."
(repology--make-display problems
"*Repology Problems*"
@@ -1158,14 +1116,14 @@ Columns are displayed according to
`repology-display-problems-columns'."
This function interacts with Repology API in three ways. You can:
1. List all packages associated to a given project. See function
- `repology-project-lookup'.
+ `repology-lookup-project'.
2. Find potential problems related to packages in a repository, using
- `repology-repository-problems'. The function provides the list of
+ `repology-report-problems'. The function provides the list of
repositories to choose from.
3. Search for projects matching some criteria. Here, you build incrementally
- a filter by selecting properties from a list. See
`repology-projects-search'
+ a filter by selecting properties from a list. See
`repology-search-projects'
for more information. Select \"OK\" to actually send the request.
During the filter creation, you may change the maximum number of projects
@@ -1173,14 +1131,14 @@ This function interacts with Repology API in three
ways. You can:
value is `repology-projects-limit'."
(interactive)
(pcase (read-char "Action: [S]earch projects [L]ookup project \
-\[B]rowse repository problems")
- ((or ?b ?B)
+\[R]eport repository problems")
+ ((or ?r ?R)
(repology-display-problems
- (repology-repository-problems
+ (repology-report-problems
(repology--query-repository "Repository: " nil))))
((or ?l ?L)
(repology-display-packages
- (repology-project-lookup (read-string "Project: "))))
+ (repology-lookup-project (read-string "Project: "))))
((or ?s ?S)
(let* ((query nil)
(limit repology-projects-limit)
@@ -1215,10 +1173,10 @@ This function interacts with Repology API in three
ways. You can:
(setq query (plist-put query filter value))))))))
;; Eventually send complete request to Repology API.
(repology-display-projects (let ((repology-projects-limit limit))
- (apply #'repology-projects-search query))
+ (apply #'repology-search-projects query))
;; Selected repository, or nil.
(plist-get query :inrepo))))
- (c (user-error "Unknown answer: %c. Aborting" c))))
+ (_ (user-error "Unknown answer. Aborting"))))
(provide 'repology)