Skip to content

Instantly share code, notes, and snippets.



Last active Jan 21, 2018
What would you like to do?
A Roswell script for opening HyperSpec page describing a given symbol in the default browser.
#|-*- mode:lisp -*-|#
exec ros -Q -- $0 "$@"
A Roswell script to open the HyperSpec page of a specified symbol in the default browser.
$ clhs [SYMBOL]
Just download this script, give execute permission, and move to somewhere your shell can find it (assuming `~/.roswell/bin/` is in $PATH in the following example).
$ wget -O clhs
$ chmod u+x clhs
$ mv clhs ~/.roswell/bin
You may want to `ros build` for creating an executable file for fast execution.
$ ros build clhs.ros
$ mv clhs ~/.roswell/bin
Environment variables
The base URL of HyperSpec. The default is LispWorks'.
Command name to open an URL with the default browser.
The default value is 'open' for Mac and 'xdg-open' for Linux.
Copyright (c) 2015 Eitaro Fukamachi, Masatoshi Sano
This script is licensed under the MIT License.
;; Loading dependencies
(unless (find-package :uiop)
(ql:quickload '(:uiop) :silent t))
;; Special variables
(defparameter *clhs-base-url*
(or (uiop:getenv "CLHS_BASE_URL")
(defparameter *clhs-cache-directory*
(let ((cache-dir
(uiop:ensure-directory-pathname (uiop:getenv "XDG_CACHE_HOME")
(merge-pathnames ".cache/" (user-homedir-pathname)))))
(merge-pathnames #P"clhs/" cache-dir)))
(defparameter *clhs-cache-file*
(merge-pathnames #P"symbols-map.sexp" *clhs-cache-directory*))
(defparameter *open-command*
(or (uiop:getenv "CLHS_OPEN_COMMAND")
#+darwin "open"
#+linux "xdg-open"
#+(or windows win32) "explorer"
#-(or darwin linux windows win32)
(error "CLHS_OPEN_COMMAND is not set.")))
;; Utilities
(defun terminate (code &optional message &rest args)
(when message
(format *error-output* "~&~A~%"
(apply #'format nil (princ-to-string message) args)))
(uiop:quit code))
;; Copied from Qlot
(defmacro with-package-functions (package-designator functions &body body)
(let ((args (gensym "ARGS")))
`(flet (,@(loop for fn in functions
collect `(,fn (&rest ,args)
,(if (and (listp fn) (eq (car fn) 'setf))
`(eval `(function (setf ,(intern ,(string (cadr fn)) ,package-designator))))
`(symbol-function (intern ,(string fn) ,package-designator)))
(defun retrieve-url (url)
(with-package-functions :drakma (http-request)
(tagbody retry
(multiple-value-bind (body status)
(http-request url)
(unless (= status 200)
(error "Failed to retrieve ~S (Code=~A)" url status)
(retry-request ()
:report "Retry the request to URL."
(go retry))))
(return-from retrieve-url body)))))
;; Here we go!
(defun clhs-url (path)
(format nil "~A~A" *clhs-base-url* path))
(defun retrieve-clhs-symbols-map ()
(ql:quickload '(:drakma :plump :clss) :silent t)
(with-package-functions :plump (parse text attribute)
(with-package-functions :clss (select)
(let ((body (retrieve-url (clhs-url "Front/X_AllSym.htm"))))
(map 'list
(lambda (a)
(cons (text a)
(let ((path (attribute a "href")))
;; Omit "../" and URL fragment
(subseq path 3 (position #\# path)))))
(select "a[rel=definition]" (parse body)))))))
(defun clhs-symbols-map ()
(if (probe-file *clhs-cache-file*)
(uiop:read-file-form *clhs-cache-file*)
(let ((symbols (retrieve-clhs-symbols-map)))
(ensure-directories-exist *clhs-cache-file*)
(with-open-file (out *clhs-cache-file*
:direction :output
:if-does-not-exist :create)
(prin1 symbols out))
(defun find-symbol-path (target-symbol)
(cdr (assoc target-symbol (clhs-symbols-map)
:test #'string-equal)))
(defun main (&optional target-symbol &rest argv)
(declare (ignore argv))
(unless target-symbol
(terminate -1 "Usage: clhs [SYMBOL]"))
(let ((path (find-symbol-path target-symbol)))
(if path
(let ((url (clhs-url path)))
(format t "~&Opening ~S~%" url)
(uiop:run-program `(,*open-command* ,url) :ignore-error-status t))
(terminate -1 "Symbol not found: ~A" target-symbol))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.