├── .gitignore ├── README.md ├── api-client.lisp ├── api-server.lisp ├── apropos-random-string.png ├── build-index.lisp ├── quicklisp-apropos.el ├── quicklisp-apropos.lisp ├── quicklisp-controller.lisp └── system-parser.lisp /.gitignore: -------------------------------------------------------------------------------- 1 | *.fasl 2 | *~ 3 | /quicklisp-apropos-index/ 4 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # quicklisp-apropos 2 | 3 | Apropos across Quicklisp libraries. 4 | 5 | Example of `apropos-function` with the query: "random string": 6 | 7 | ![apropos-random-string-example](apropos-random-string.png "Example result of apropos with 'random string' as query") 8 | 9 | ## Install 10 | 11 | ### Install dependencies 12 | 13 | ```lisp 14 | (ql:quickload '(:dexador :chipz :archive :montezuma :string-case)) 15 | ``` 16 | 17 | ### REPL access 18 | 19 | This library does not require Emacs and SLIME. 20 | 21 | Load `quicklisp-apropos.lisp`. Then evaluate the `apropos` functions in `quicklisp-apropos` package from a Lisp listener. 22 | 23 | ### SLIME extension 24 | 25 | ℹ️ Please consider using [SLIME :star:](https://github.com/mmontone/slime-star), that comes with this extension preinstalled. 26 | 27 | The SLIME extension displays apropos results in Emacs buffers from which you can directly navigate to the matching definitons. 28 | 29 | Load `swank` and add this repository path to `swank::*load-path*`, in your Lisp compiler init file (~/.sbclrc if using SBCL): 30 | 31 | ```lisp 32 | (require :swank) 33 | (push #p"/home/marian/src/lisp/quicklisp-apropos/" swank::*load-path*) 34 | ``` 35 | 36 | In Emacs, add this repository path to `load-path` and add `quicklisp-apropos` to `slime-contribs` in `~/.emacs` init file, like: 37 | 38 | ``` 39 | (push "/home/marian/src/lisp/quicklisp-apropos" load-path) 40 | 41 | (setq slime-contribs '(slime-fancy quicklisp-apropos)) 42 | 43 | (slime-setup) 44 | ``` 45 | 46 | ## Use 47 | 48 | ### QUICKLISP-APROPOS package functions 49 | 50 | * `APROPOS` 51 | Function: Perform apropos QUERY across libraries in Quicklisp. 52 | * `APROPOS-CLASS` 53 | Function: Perform apropos QUERY to match exported CLOS classes of Quicklisp libraries. 54 | * `APROPOS-DOC` 55 | Function: Perform apropos QUERY to match in documentation of exported definitions of Quicklisp libraries. 56 | * `APROPOS-FUNCTION` 57 | Function: Perform apropos QUERY to match exported functions of Quicklisp libraries. 58 | * `APROPOS-GENERIC-FUNCTION` 59 | Function: Perform apropos QUERY to match exported CLOS generic functions of Quicklisp libraries. 60 | * `APROPOS-MACRO` 61 | Function: Perform apropos QUERY to match exported macros of Quicklisp libraries. 62 | * `APROPOS-NAME` 63 | Function: Perform apropos QUERY to match exported names of Quicklisp libraries. 64 | * `APROPOS-PACKAGE` 65 | Function: Perform apropos QUERY on packages of Quicklisp libraries. 66 | * `APROPOS-SYSTEM` 67 | Function: Perform apropos QUERY on ASDF systems of Quicklisp libraries. 68 | * `APROPOS-VARIABLE` 69 | Function: Perform apropos QUERY to match exported variables of Quicklisp libraries. 70 | 71 | ### Emacs commands 72 | 73 | * `quicklisp-apropos` 74 | Apropos quicklisp using a generic QUERY. 75 | * `quicklisp-apropos-class` 76 | Search across CLOS classes exported in Quicklisp libraries that 77 | match the QUERY. 78 | * `quicklisp-apropos-function` 79 | Search across Lisp functions exported in Quicklisp libraries that 80 | match the QUERY. 81 | * `quicklisp-apropos-generic-function` 82 | Search across CLOS generic functions exported in Quicklisp 83 | libraries that match the QUERY. 84 | * `quicklisp-apropos-macro` 85 | Search across Lisp macros exported in Quicklisp libraries that 86 | match the QUERY. 87 | * `quicklisp-apropos-package` 88 | Search across Lisp packages in Quicklisp libraries that match the 89 | QUERY. 90 | * `quicklisp-apropos-system` 91 | Search across ASDF systems in Quicklisp libraries that match the 92 | QUERY. 93 | * `quicklisp-apropos-variable` 94 | Search across Lisp variables exported in Quicklisp libraries that 95 | match the QUERY. 96 | * `quicklisp-apropos-update-index` 97 | Download and update quicklisp-apropos index. 98 | 99 | ## How it works 100 | 101 | A [Montezuma](https://github.com/sharplispers/montezuma) index is downloaded from the internet. 102 | Montezuma is a text search engine library for Common Lisp. 103 | The downloaded index contains information about definitions exported by all Quicklisp libraries. 104 | Apropos functions perform Montezuma queries over that index and displays the results. 105 | -------------------------------------------------------------------------------- /api-client.lisp: -------------------------------------------------------------------------------- 1 | (require :drakma) 2 | (require :cl-json) 3 | 4 | (defpackage :quicklisp-apropos-client 5 | (:use :cl)) 6 | 7 | (in-package :quicklisp-apropos-client) 8 | 9 | (defvar *index-url*) 10 | 11 | (defun format-query (query) 12 | (when (stringp query) 13 | (return-from format-query query)) 14 | (when (listp query) 15 | ())) 16 | 17 | (defun query-api (query) 18 | (json:decode-json-from-source 19 | (drakma:http-request *index-url* 20 | :parameters (list (cons "q" query)) 21 | :want-stream t))) 22 | 23 | (defun print-result (result) 24 | (format t "~a ~a in system ~a~%" 25 | (alexandria:assoc-value result :type) 26 | (alexandria:assoc-value result :name) 27 | (alexandria:assoc-value result :system)) 28 | (when (alexandria:assoc-value result :doc) 29 | (format t "~%~a~%" (alexandria:assoc-value result :doc)))) 30 | 31 | (defun print-results (results) 32 | (format t "~a results:~%~%" (length results)) 33 | (format t "--------------------------------------------------------------------------------~%") 34 | (dolist (result results) 35 | (print-result result) 36 | (format t "--------------------------------------------------------------------------------~%"))) 37 | -------------------------------------------------------------------------------- /api-server.lisp: -------------------------------------------------------------------------------- 1 | (require :hunchentoot) 2 | (require :montezuma) 3 | (require :string-case) 4 | (require :cl-json) 5 | 6 | (defpackage :quicklisp-apropos-server 7 | (:use :cl)) 8 | 9 | (in-package :quicklisp-apropos-server) 10 | 11 | (defparameter *index* (make-instance 'montezuma:index 12 | :path "/home/marian/src/quicklisp-docs-index" 13 | :create-if-missing-p nil)) 14 | 15 | (defun parse-document (doc) 16 | (flet ((docvalue (field) 17 | (let ((val (montezuma:document-value doc field))) 18 | ;; NILs in Montezuma are stored as a string "NIL" 19 | (when (not (string= val "NIL")) 20 | val)))) 21 | (string-case:string-case ((docvalue "type")) 22 | ("system" 23 | (list (cons "type" "system") 24 | (cons "name" (docvalue "name")) 25 | (cons "doc" (docvalue "doc")))) 26 | ("package" 27 | (list (cons "type" "package") 28 | (cons "name" (docvalue "name")) 29 | (cons "doc" (docvalue "doc")) 30 | (cons "system" (docvalue "system")))) 31 | (t 32 | (list (cons "type" (docvalue "type")) 33 | (cons "name" (docvalue "name")) 34 | (cons "doc" (docvalue "doc")) 35 | (cons "package" (docvalue "package")) 36 | (cons "system" (docvalue "system"))))))) 37 | 38 | (defun query-index (query) 39 | (let (found) 40 | (montezuma:search-each *index* query 41 | #'(lambda (doc score) 42 | (push (cons (parse-document (montezuma:get-document *index* doc)) score) found)) 43 | '(:num-docs 50)) 44 | (nreverse found))) 45 | 46 | (hunchentoot:define-easy-handler (query-handler :uri "/") 47 | (q) 48 | (setf (hunchentoot:header-out "content-type") "application/json") 49 | (json:encode-json-to-string 50 | (mapcar #'car (query-index q)))) 51 | 52 | (defvar *acceptor*) 53 | 54 | (defun start (&rest args) 55 | (setf *acceptor* 56 | (hunchentoot:start (apply #'make-instance 'hunchentoot:easy-acceptor args)))) 57 | -------------------------------------------------------------------------------- /apropos-random-string.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mmontone/quicklisp-apropos/84dddc06183630c214033afa86605f7b21a80a3f/apropos-random-string.png -------------------------------------------------------------------------------- /build-index.lisp: -------------------------------------------------------------------------------- 1 | ;; - Clone quicklisp-projects and quicklisp-controller repositories. 2 | ;; - Setup quicklisp-controller: (quicklisp-controller:setup-directories "~/src/lisp/quicklisp-projects/") 3 | ;; - Update the list of Quicklisp systems using QUICKLISP-CONTROLLER::UPDATE-WHAT-YOU-CAN. 4 | 5 | (defpackage #:quicklisp-apropos-index 6 | (:use #:cl) 7 | (:export #:index-quicklisp-systems)) 8 | 9 | (in-package #:quicklisp-apropos-index) 10 | 11 | (defun find-files-do (path pattern function &optional (include-subdirectories t)) 12 | "Find files in PATH using PATTERN. Invokes FUNCTION on found files. 13 | If INCLUDE-SUBDIRECTORIES is T, then work recursively." 14 | (dolist (file (uiop/filesystem:directory-files path pattern)) 15 | (funcall function file)) 16 | (when include-subdirectories 17 | (dolist (subdir (uiop/filesystem:subdirectories path)) 18 | (find-files-do subdir pattern function include-subdirectories)))) 19 | 20 | (defun index-quicklisp-systems (quicklisp-controller-directory &key start-after-system ignore) 21 | "Build a Montezuma index with information about all exported definitions in Quicklisp libraries." 22 | (let ((start (not start-after-system))) 23 | (find-files-do 24 | (merge-pathnames #p"upstream-cache/" quicklisp-controller-directoryx) 25 | "*.asd" 26 | (lambda (file) 27 | (let ((system-name (pathname-name file))) 28 | (print system-name) 29 | (when (and (not start) start-after-system) 30 | (when (string= start-after-system system-name) 31 | (setq start t))) 32 | (when (and start 33 | (not (member system-name ignore :test #'string=))) 34 | (with-simple-restart (skip "Skip to next system") 35 | (uiop:run-program 36 | (format nil "sbcl --load 'system-parser.lisp' --eval '(system-parser:index-system \"~a\")' --quit" system-name) 37 | :output t :error-output t)))))))) 38 | -------------------------------------------------------------------------------- /quicklisp-apropos.el: -------------------------------------------------------------------------------- 1 | ;;; quicklisp-apropos.el --- Commands for quicklisp-apropos -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2023 Mariano Montone 4 | 5 | ;; This program is free software; you can redistribute it and/or modify 6 | ;; it under the terms of the GNU General Public License as published by 7 | ;; the Free Software Foundation, either version 3 of the License, or 8 | ;; (at your option) any later version. 9 | 10 | ;; This program is distributed in the hope that it will be useful, 11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ;; GNU General Public License for more details. 14 | 15 | ;; You should have received a copy of the GNU General Public License 16 | ;; along with this program. If not, see . 17 | 18 | ;;; Commentary: 19 | 20 | ;; Install: 21 | ;; Emacs side: just put this file in your load-path and load it on init. 22 | ;; Lisp side: (load "quicklisp-apropos.lisp") in your init file (i.e. .sbclrc). 23 | 24 | ;; Use: 25 | ;; M-x quicklisp-apropos 26 | ;; Customize max results with: M-x customize-variable RET quicklisp-apropos-max-results RET 27 | 28 | ;;; Code: 29 | 30 | (require 'slime) 31 | 32 | (defgroup quicklisp-apropos nil 33 | "Quicklisp-apropos settings." 34 | :group 'slime) 35 | 36 | (defcustom quicklisp-apropos-max-results 50 37 | "Maximum number of results to be returned by quicklisp-apropos." 38 | :type 'integer 39 | :group 'quicklisp-apropos) 40 | 41 | (defcustom quicklisp-apropos-query-results-function 42 | 'quicklisp-apropos--query-results 43 | "Internal function to use for fetching and showing quicklisp-apropos results." 44 | :type 'symbol 45 | :group 'quicklisp-apropos) 46 | 47 | (defun quicklisp-apropos-update-index () 48 | "Download and update quicklisp-apropos index." 49 | (interactive) 50 | (message "Downloding quicklisp-apropos index ...") 51 | (slime-eval '(quicklisp-apropos:download-index)) 52 | (message "quicklisp-apropos index updated.")) 53 | 54 | ;; Taken from elisp-mode, after elisp-mode--docstring-first-line. 55 | ;; Note that any leading `*' in the docstring (which indicates the variable 56 | ;; is a user option) is removed. 57 | (defun quicklisp-apropos--docstring-first-line (doc) 58 | "Return first line of DOC." 59 | (and (stringp doc) 60 | (substitute-command-keys 61 | (save-match-data 62 | ;; Don't use "^" in the regexp below since it may match 63 | ;; anywhere in the doc-string. 64 | (let ((start (if (string-match "\\`\\*" doc) (match-end 0) 0))) 65 | (cond ((string-match "\n" doc) 66 | (substring doc start (match-beginning 0))) 67 | ((zerop start) doc) 68 | (t (substring doc start)))))))) 69 | 70 | (defun quicklisp-apropos--open-buffer-with-results (buffer-name results) 71 | "Open a buffer named with BUFFER-NAME and show the list of apropos RESULTS." 72 | (let ((buffer (get-buffer-create buffer-name))) 73 | (with-current-buffer buffer 74 | (dolist (result results) 75 | (let ((name (cdr (assoc-string "name" result))) 76 | (type (cdr (assoc-string "type" result))) 77 | (doc (cdr (assoc-string "doc" result))) 78 | (system (cdr (assoc-string "system" result)))) 79 | (if (string= type "system") 80 | (insert-button (upcase name) 81 | 'follow-link t 82 | 'help-echo "Load system." 83 | 'face 'slime-apropos-symbol 84 | 'action (lambda (_) 85 | (when (yes-or-no-p (format "Load %s system?" name)) 86 | (slime-eval `(ql:quickload ,name))))) 87 | ;; else 88 | (insert-button name 89 | 'follow-link t 90 | 'help-echo "Load system and edit definition." 91 | 'face 'slime-apropos-symbol 92 | 'action (lambda (_) 93 | (when (yes-or-no-p (format "Load %s system?" system)) 94 | (slime-eval `(ql:quickload ,system)) 95 | (slime-edit-definition name))))) 96 | (when system 97 | (insert " in system ") 98 | (insert-button system 99 | 'follow-link t 100 | 'help-echo "Load system" 101 | 'action (lambda (_) 102 | (when (yes-or-no-p (format "Load %s system?" system)) 103 | (slime-eval `(ql:quickload ,system)))))) 104 | (newline) 105 | (insert " " (propertize (capitalize type) 'face 'underline) ": ") 106 | (if doc 107 | (insert (quicklisp-apropos--docstring-first-line doc)) 108 | (insert "Not documented")) 109 | (newline))) 110 | (local-set-key "q" 'kill-buffer) 111 | (setq buffer-read-only t) 112 | (buffer-disable-undo) 113 | (goto-char 0) 114 | (pop-to-buffer buffer)))) 115 | 116 | (defun quicklisp-apropos--open-buffer-with-printed-results (buffer-name results) 117 | "Open a buffer named with BUFFER-NAME and show the printed apropos RESULTS." 118 | (let ((buffer (get-buffer-create buffer-name))) 119 | (with-current-buffer buffer 120 | (insert results) 121 | (local-set-key "q" 'kill-buffer) 122 | (setq buffer-read-only t) 123 | (buffer-disable-undo) 124 | (goto-char 0) 125 | (pop-to-buffer buffer)))) 126 | 127 | (defun quicklisp-apropos--query-printed-results (apropos-function query) 128 | "Call APROPOS-FUNCTION with QUERY. 129 | The printed results are show in an Emacs buffer." 130 | (let* ((results 131 | (slime-eval `(cl:with-output-to-string 132 | (cl:*standard-output*) 133 | (,apropos-function ,query :count ,quicklisp-apropos-max-results)))) 134 | (buffer-name (format "*quicklisp-apropos: %s*" query))) 135 | (quicklisp-apropos--open-buffer-with-printed-results buffer-name results))) 136 | 137 | (defun quicklisp-apropos--query-results (apropos-function query) 138 | "Call APROPOS-FUNCTION with QUERY. Show result in an Emacs buffer." 139 | (let* ((results 140 | (slime-eval `(,apropos-function ,query :count ,quicklisp-apropos-max-results :print-results nil))) 141 | (buffer-name (format "*quicklisp-apropos: %s*" query))) 142 | (quicklisp-apropos--open-buffer-with-results buffer-name 143 | (mapcar #'car results)))) 144 | 145 | (defun quicklisp-apropos (query) 146 | "Apropos quicklisp using a generic QUERY. 147 | If QUERY contains a ?: color character, then interpret the query 148 | as a Montezuma query string. 149 | Otherwise, build a proper Montezuma query with the term, 150 | one that looks into 'name' and 'doc' fields." 151 | 152 | (interactive "sQuicklisp apropos: ") 153 | 154 | (funcall quicklisp-apropos-query-results-function 155 | 'quicklisp-apropos:apropos query)) 156 | 157 | (defun quicklisp-apropos-system (query) 158 | "Search across ASDF systems in Quicklisp libraries that match the QUERY." 159 | (interactive "sQuicklisp apropos system: ") 160 | (funcall quicklisp-apropos-query-results-function 161 | 'quicklisp-apropos:apropos-system query)) 162 | 163 | (defun quicklisp-apropos-package (query) 164 | "Search across Lisp packages in Quicklisp libraries that match the QUERY." 165 | (interactive "sQuicklisp apropos package: ") 166 | (funcall quicklisp-apropos-query-results-function 167 | 'quicklisp-apropos:apropos-package query)) 168 | 169 | (defun quicklisp-apropos-variable (query) 170 | "Search across Lisp variables exported in Quicklisp libraries that match the QUERY." 171 | (interactive "sQuicklisp apropos variable: ") 172 | (funcall quicklisp-apropos-query-results-function 173 | 'quicklisp-apropos:apropos-variable query)) 174 | 175 | (defun quicklisp-apropos-class (query) 176 | "Search across CLOS classes exported in Quicklisp libraries that match the QUERY." 177 | (interactive "sQuicklisp apropos class: ") 178 | (funcall quicklisp-apropos-query-results-function 179 | 'quicklisp-apropos:apropos-class query)) 180 | 181 | (defun quicklisp-apropos-function (query) 182 | "Search across Lisp functions exported in Quicklisp libraries that match the QUERY." 183 | (interactive "sQuicklisp apropos function: ") 184 | 185 | (funcall quicklisp-apropos-query-results-function 186 | 'quicklisp-apropos:apropos-function query)) 187 | 188 | (defun quicklisp-apropos-macro (query) 189 | "Search across Lisp macros exported in Quicklisp libraries that match the QUERY." 190 | (interactive "sQuicklisp apropos macro: ") 191 | 192 | (funcall quicklisp-apropos-query-results-function 193 | 'quicklisp-apropos:apropos-macro query)) 194 | 195 | (defun quicklisp-apropos-generic-function (query) 196 | "Search across CLOS generic functions exported in Quicklisp libraries that match the QUERY." 197 | (interactive "sQuicklisp apropos generic function: ") 198 | 199 | (funcall quicklisp-apropos-query-results-function 200 | 'quicklisp-apropos:apropos-generic-function query)) 201 | 202 | ;;---- SLIME integration ------------------------------------------------------ 203 | 204 | (defun quicklisp-apropos--add-to-slime-menu () 205 | "Add quicklisp-apropos menu to SLIME menu." 206 | (easy-menu-add-item 'menubar-slime nil '("---")) 207 | (easy-menu-add-item 'menubar-slime nil 208 | '("Quicklisp apropos" 209 | ["Apropos" quicklisp-apropos 210 | :help "Apropos across Quicklisp libraries."] 211 | ["Apropos function" quicklisp-apropos-function 212 | :help "Apropos functions exported across Quicklisp libraries."] 213 | ["Apropos variable" quicklisp-apropos-variable 214 | :help "Apropos variables exported across Quicklisp libraries."] 215 | ["Apropos class" quicklisp-apropos-class 216 | :help "Apropos classes exported across Quicklisp libraries."] 217 | ["Apropos system" quicklisp-apropos-system 218 | :help "Apropos ASDF systems across Quicklisp libraries."] 219 | ["Apropos package" quicklisp-apropos-package 220 | :help "Apropos packages across Quicklisp libraries."] 221 | ["Update index" quicklisp-apropos-update-index 222 | :help "Download and update quicklisp-apropos index."] 223 | ))) 224 | 225 | (define-slime-contrib quicklisp-apropos 226 | "Apropos across Quicklisp libraries." 227 | (:authors "Mariano Montone") 228 | (:license "GPL") 229 | (:swank-dependencies quicklisp-apropos) 230 | (:on-load 231 | (quicklisp-apropos--add-to-slime-menu))) 232 | 233 | (provide 'quicklisp-apropos) 234 | 235 | ;;; quicklisp-apropos.el ends here 236 | -------------------------------------------------------------------------------- /quicklisp-apropos.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright (C) 2023 Mariano Montone 2 | 3 | ;; This program is free software; you can redistribute it and/or modify 4 | ;; it under the terms of the GNU General Public License as published by 5 | ;; the Free Software Foundation, either version 3 of the License, or 6 | ;; (at your option) any later version. 7 | 8 | ;; This program is distributed in the hope that it will be useful, 9 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | ;; GNU General Public License for more details. 12 | 13 | ;; You should have received a copy of the GNU General Public License 14 | ;; along with this program. If not, see . 15 | 16 | (require :dexador) 17 | (require :quicklisp) 18 | (require :chipz) 19 | (require :archive) 20 | (require :montezuma) 21 | (require :string-case) 22 | 23 | (defpackage :quicklisp-apropos 24 | (:use :cl) 25 | (:shadow #:apropos) 26 | (:export 27 | #:*index-path* 28 | #:apropos 29 | #:apropos-system 30 | #:apropos-package 31 | #:apropos-class 32 | #:apropos-variable 33 | #:apropos-function 34 | #:apropos-generic-function 35 | #:apropos-macro 36 | #:apropos-name 37 | #:apropos-doc 38 | #:download-index) 39 | (:documentation "Provides apropos functions that work across Quicklisp libraries.")) 40 | 41 | (in-package :quicklisp-apropos) 42 | 43 | (defparameter *quicklisp-apropos-directory* 44 | (uiop/pathname:pathname-directory-pathname *load-pathname*) 45 | "This is the root path for the index. Uses *LOAD-PATHNAME* as default.") 46 | (defparameter *index-path* 47 | (merge-pathnames "quicklisp-apropos-index/" *quicklisp-apropos-directory*) 48 | "The path of the Montezuma index with Quicklisp libraries definitions information.") 49 | (defparameter *index* nil 50 | "The Montezuma index.") 51 | (defvar *results-count* 50 52 | "Number of results to fetch in Montezuma queries.") 53 | (defvar *index-file-url* 54 | "https://github.com/mmontone/quicklisp-apropos/releases/latest/download/quicklisp-apropos-index.tar.gz" 55 | "The url of the index file to download.") 56 | 57 | ;;-------- Index update ------------------------------------------------------- 58 | 59 | (defun extract-tarball (pathname) 60 | "Extract a tarball (.tar.gz) file to a directory (*default-pathname-defaults*)." 61 | (with-open-file (tarball-stream pathname 62 | :direction :input 63 | :element-type '(unsigned-byte 8)) 64 | (archive::extract-files-from-archive 65 | (archive:open-archive 'archive:tar-archive 66 | (chipz:make-decompressing-stream 'chipz:gzip tarball-stream) 67 | :direction :input)))) 68 | 69 | (defun download-index (&optional (index-file-url *index-file-url*)) 70 | "Download index from INDEX-FILE-URL." 71 | (format t "Downloading quicklisp-apropos index from ~a ... ~%" index-file-url) 72 | (ql-util:with-temporary-file (quicklisp-apropos-index.tar.gz (file-namestring index-file-url)) 73 | (dex:fetch index-file-url quicklisp-apropos-index.tar.gz) 74 | (format t "Extracting index ...~%") 75 | (let ((*default-pathname-defaults* *quicklisp-apropos-directory*)) 76 | (extract-tarball quicklisp-apropos-index.tar.gz)) 77 | (format t "Index created in ~a~%" *quicklisp-apropos-directory*))) 78 | 79 | (defun ensure-index () 80 | "Make sure an index has been downloaded." 81 | (when (null *index*) 82 | (when (not (probe-file *index-path*)) 83 | (download-index)) 84 | (setf *index* (make-instance 'montezuma:index :path *index-path* 85 | :create-if-missing-p nil)))) 86 | 87 | (defun format-query (query) 88 | "Format a Montezuma query from QUERY." 89 | (when (stringp query) 90 | (return-from format-query query)) 91 | (when (listp query) 92 | (error "TODO"))) 93 | 94 | (defun parse-document (doc) 95 | "Parse Montezuma DOC into an alist." 96 | (flet ((docvalue (field) 97 | (let ((val (montezuma:document-value doc field))) 98 | ;; NILs in Montezuma are stored as a string "NIL" 99 | (when (not (string= val "NIL")) 100 | val)))) 101 | (string-case:string-case ((docvalue "type")) 102 | ("system" 103 | (list (cons "type" "system") 104 | (cons "name" (docvalue "name")) 105 | (cons "doc" (docvalue "doc")))) 106 | ("package" 107 | (list (cons "type" "package") 108 | (cons "name" (docvalue "name")) 109 | (cons "doc" (docvalue "doc")) 110 | (cons "system" (docvalue "system")))) 111 | (t 112 | (list (cons "type" (docvalue "type")) 113 | (cons "name" (docvalue "name")) 114 | (cons "doc" (docvalue "doc")) 115 | (cons "package" (docvalue "package")) 116 | (cons "system" (docvalue "system"))))))) 117 | 118 | (defun query-index (query &key (count *results-count*)) 119 | "Query the index." 120 | (let (found) 121 | (montezuma:search-each *index* query 122 | #'(lambda (doc score) 123 | (push (cons (parse-document (montezuma:get-document *index* doc)) score) found)) 124 | `(:num-docs ,count)) 125 | (nreverse found))) 126 | 127 | (defun print-result (result) 128 | "Print an apropos RESULT to *STANDARD-OUTPUT*." 129 | (format t "~a ~a in system ~a~%" 130 | (alexandria:assoc-value result "type" :test #'string=) 131 | (alexandria:assoc-value result "name" :test #'string=) 132 | (alexandria:assoc-value result "system" :test #'string=)) 133 | (when (alexandria:assoc-value result "doc" :test #'string=) 134 | (format t "~%~a~%" (alexandria:assoc-value result "doc" :test #'string=)))) 135 | 136 | (defun print-results (results) 137 | "Print apropos RESULTS to *STANDARD-OUTPUT*" 138 | (format t "~a results:~%~%" (length results)) 139 | (format t "--------------------------------------------------------------------------------~%") 140 | (dolist (result results) 141 | (print-result (car result)) 142 | (format t "--------------------------------------------------------------------------------~%"))) 143 | 144 | (defun maybe-print-results (results print-p) 145 | (if print-p 146 | (print-results results) 147 | results)) 148 | 149 | ;;------ Apropos api ------------------------------------------------------------ 150 | 151 | (defun apropos (query &key (count *results-count*) 152 | (print-results t)) 153 | "Perform apropos QUERY across libraries in Quicklisp." 154 | (ensure-index) 155 | (when (not (find #\: query)) 156 | (setq query (format nil "name:'~a', doc:'~a'" query query))) 157 | (maybe-print-results (query-index query :count count) print-results)) 158 | 159 | (defun apropos-system (query &key (count *results-count*) (print-results t)) 160 | "Perform apropos QUERY on ASDF systems of Quicklisp libraries." 161 | (ensure-index) 162 | (maybe-print-results (query-index (format nil "+type:system, name: '~a', doc:'~a'" 163 | query query) 164 | :count count) 165 | print-results)) 166 | 167 | (defun apropos-package (query &key (count *results-count*) (print-results t)) 168 | "Perform apropos QUERY on packages of Quicklisp libraries." 169 | (ensure-index) 170 | (maybe-print-results (query-index (format nil "+type:package, name:'~a', doc:'~a'" query query) :count count) 171 | print-results)) 172 | 173 | (defun apropos-name (query &key (count *results-count*) (print-results t)) 174 | "Perform apropos QUERY to match exported names of Quicklisp libraries." 175 | (ensure-index) 176 | (maybe-print-results (query-index (format nil "+name:'~a'" query) :count count) print-results)) 177 | 178 | (defun apropos-doc (query &key (count *results-count*) (print-results t)) 179 | "Perform apropos QUERY to match in documentation of exported definitions of Quicklisp libraries." 180 | (ensure-index) 181 | (maybe-print-results (query-index (format nil "+doc:'~a'" query) :count count) print-results)) 182 | 183 | (defun apropos-variable (query &key (count *results-count*) (print-results t)) 184 | "Perform apropos QUERY to match exported variables of Quicklisp libraries." 185 | (ensure-index) 186 | (maybe-print-results (query-index (format nil "+type:variable, name:'~a', doc:'~a'" query query) :count count) print-results)) 187 | 188 | (defun apropos-class (query &key (count *results-count*) (print-results t)) 189 | "Perform apropos QUERY to match exported CLOS classes of Quicklisp libraries." 190 | (ensure-index) 191 | (maybe-print-results (query-index (format nil "+type:class, name:'~a',doc:'~a'" query query) :count count) print-results)) 192 | 193 | (defun apropos-function (query &key (count *results-count*) (print-results t)) 194 | "Perform apropos QUERY to match exported functions of Quicklisp libraries." 195 | (ensure-index) 196 | (maybe-print-results (query-index (format nil "+type:function, name:'~a', doc:'~a'" query query) :count count) print-results)) 197 | 198 | (defun apropos-macro (query &key (count *results-count*) (print-results t)) 199 | "Perform apropos QUERY to match exported macros of Quicklisp libraries." 200 | (ensure-index) 201 | (maybe-print-results (query-index (format nil "+type:'macro', name:'~a', doc:'~a'" query query) :count count) print-results)) 202 | 203 | (defun apropos-generic-function (query &key (count *results-count*) (print-results t)) 204 | "Perform apropos QUERY to match exported CLOS generic functions of Quicklisp libraries." 205 | (ensure-index) 206 | (maybe-print-results (query-index (format nil "+type:'generic-function', name:'~a', doc:'~a'" query query) :count count) print-results)) 207 | 208 | (provide :quicklisp-apropos) 209 | -------------------------------------------------------------------------------- /quicklisp-controller.lisp: -------------------------------------------------------------------------------- 1 | (load "~/src/lisp/quicklisp-controller/quicklisp-controller.asd") 2 | (load "~/src/lisp/githappy/githappy.asd") 3 | (load "~/src/lisp/project-info/project-info.asd") 4 | (asdf:operate 'asdf:load-op :quicklisp-controller) 5 | (quicklisp-controller:setup-directories "~/src/lisp/quicklisp-projects/") 6 | (QUICKLISP-CONTROLLER::UPDATE-WHAT-YOU-CAN) 7 | -------------------------------------------------------------------------------- /system-parser.lisp: -------------------------------------------------------------------------------- 1 | (require :docparser) 2 | (require :montezuma) 3 | 4 | (defpackage :system-parser 5 | (:use :cl) 6 | (:export :index-system)) 7 | 8 | (in-package :system-parser) 9 | 10 | (defparameter *index* (make-instance 'montezuma:index :path "quicklisp-apropos-index")) 11 | 12 | (defun make-document (node system) 13 | (typecase node 14 | (docparser:package-index 15 | (list (cons "type" "package") 16 | (cons "name" (docparser:package-index-name node)) 17 | (cons "doc" (docparser:package-index-docstring node)) 18 | (cons "system" (princ-to-string system)))) 19 | (docparser:class-node 20 | (list (cons "type" "class") 21 | (cons "name" (prin1-to-string (docparser:node-name node))) 22 | (cons "doc" (docparser:node-docstring node)) 23 | (cons "package" (package-name (symbol-package (docparser:node-name node)))) 24 | (cons "system" (princ-to-string system)))) 25 | (docparser:generic-function-node 26 | (list (cons "type" "generic-function") 27 | (cons "name" (prin1-to-string (docparser:node-name node))) 28 | (cons "doc" (docparser:node-docstring node)) 29 | (cons "package" (package-name (symbol-package (docparser:node-name node)))) 30 | (cons "system" (princ-to-string system)))) 31 | (docparser:function-node 32 | (list (cons "type" "function") 33 | (cons "name" (prin1-to-string (docparser:node-name node))) 34 | (cons "doc" (docparser:node-docstring node)) 35 | (cons "package" (package-name (symbol-package (docparser:node-name node)))) 36 | (cons "system" (princ-to-string system)))) 37 | (docparser:macro-node 38 | (list (cons "type" "macro") 39 | (cons "name" (prin1-to-string (docparser:node-name node))) 40 | (cons "doc" (docparser:node-docstring node)) 41 | (cons "package" (package-name (symbol-package (docparser:node-name node)))) 42 | (cons "system" (princ-to-string system)))) 43 | (docparser:variable-node 44 | (list (cons "type" "variable") 45 | (cons "name" (prin1-to-string (docparser:node-name node))) 46 | (cons "doc" (docparser:node-docstring node)) 47 | (cons "package" (package-name (symbol-package (docparser:node-name node)))) 48 | (cons "system" (princ-to-string system)))))) 49 | 50 | (defun read-system-doc (system-designator) 51 | (let ((readme-files (concatenate 'list 52 | (uiop/filesystem:directory-files 53 | (asdf:system-source-directory system-designator) 54 | "README*") 55 | (uiop/filesystem:directory-files 56 | (asdf:system-source-directory system-designator) 57 | "README.*"))) 58 | (system (asdf:find-system system-designator))) 59 | ;; Concatenate all documentation we found 60 | (with-output-to-string (s) 61 | (when (asdf:system-description system) 62 | (write-string (asdf:system-description system) s) 63 | (terpri s)) 64 | (when (asdf:system-long-description system) 65 | (write-string (asdf:system-long-description system) s) 66 | (terpri s)) 67 | (dolist (readme-file readme-files) 68 | (write-string (alexandria:read-file-into-string readme-file) s) 69 | (terpri s))))) 70 | 71 | (defun make-system-document (system) 72 | (list (cons "type" "system") 73 | (cons "name" (princ-to-string system)) 74 | (cons "doc" (read-system-doc system)))) 75 | 76 | (defun index-system (system) 77 | (let ((index (docparser:parse system))) 78 | (montezuma:add-document-to-index *index* (make-system-document system)) 79 | (docparser:do-packages (package index) 80 | (let ((doc (make-document package system))) 81 | (montezuma:add-document-to-index *index* doc)) 82 | (docparser:do-nodes (node package) 83 | (when (docparser:symbol-external-p (docparser:node-name node)) 84 | (let ((doc (make-document node system))) 85 | (when doc 86 | (format t ".") 87 | (montezuma:add-document-to-index *index* doc)))))))) 88 | --------------------------------------------------------------------------------