From 4cdeb0d0cc3379e55ac5dd194a56dd1bfbbefe93 Mon Sep 17 00:00:00 2001 Message-Id: <4cdeb0d0cc3379e55ac5dd194a56dd1bfbbefe93.1718879610.git.mdw@distorted.org.uk> From: Mark Wooding Date: Mon, 21 Apr 2008 12:31:21 +0100 Subject: [PATCH] New script `hyperspec'. Organization: Straylight/Edgeware From: Mark Wooding The new hyperspec script looks up an entry in the Common Lisp Hyperspec and returns the URL. Comes with bash completions! --- bash_completion | 23 +++++++ hyperspec | 176 ++++++++++++++++++++++++++++++++++++++++++++++++ setup | 3 +- 3 files changed, 201 insertions(+), 1 deletion(-) create mode 100755 hyperspec diff --git a/bash_completion b/bash_completion index 1634e81..428ed68 100644 --- a/bash_completion +++ b/bash_completion @@ -2,3 +2,26 @@ [ "$(type -t _command)" = "function" ] && complete -F _command r rootly + +declare -a _hyperspec_completions +_hyperspec_made_completions=no +_complete-hyperspec () { + case "$_hyperspec_made_completions" in + no) + _hyperspec_completions=($(hyperspec -l)) + _hyperspec_made_completions=yes + ;; + esac + COMPREPLY=() + local -i i=0 + local prefix=${COMP_WORDS[$COMP_CWORD]} + for sym in "${_hyperspec_completions[@]}"; do + case "$sym" in + $prefix*) + COMPREPLY[$i]=$sym + i+=1 + ;; + esac + done +} +complete -F _complete-hyperspec hyperspec diff --git a/hyperspec b/hyperspec new file mode 100755 index 0000000..912a83b --- /dev/null +++ b/hyperspec @@ -0,0 +1,176 @@ +#! /bin/sh +'': "-*-emacs-lisp-*-"; exec emacs --no-site-file --batch --load "$0" -- "$@" +;;; +;;; Look things up in the Common Lisp Hyperspec. +;;; +;;; (c) 2008 Mark Wooding +;;; + +;;;----- Licensing notice --------------------------------------------------- +;;; +;;; 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 2 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, write to the Free Software +;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA + +;;;-------------------------------------------------------------------------- +;;; External dependencies. + +;; We need the hyperspec library, obviously. +(require 'hyperspec) + +;; The init file probably has customizations for the Hyperspec library, in +;; particular where the local Hyperspec files are. +;; +;; Hacking here to suppress messages from the init file, and also to protect +;; us from errors in it. +(setq mdw-fast-startup t) +(let ((original-message (symbol-function 'message))) + (unwind-protect + (progn + (fset 'message #'(lambda (&rest hunoz) nil)) + (condition-case signal (load-file "~/.emacs") + (error (funcall original-message + "hyperspec (warning): .emacs erred: %s." + signal)))) + (fset 'message original-message))) + +;;;-------------------------------------------------------------------------- +;;; Utilities. + +(defvar quis "hyperspec") + +(defun die (&rest format-args) + (message "%s: %s" quis (apply #'format format-args)) + (kill-emacs 1)) + +(defvar usage-string "Usage: hyperspec -l | KEY") + +(defun die-usage () + (message "%s" usage-string) + (kill-emacs 1)) + +;;;-------------------------------------------------------------------------- +;;; Look up a string and find its URL in the Hyperspec. + +(defun hyperspec-urls (key) + "Return a list of hyperspec URLs corresponding to KEY." + (let ((urls nil) + (lookups (list (list (downcase key) + common-lisp-hyperspec-symbols + #'(lambda (values) + (mapcar (lambda (value) + (concat common-lisp-hyperspec-root + "Body/" + value)) + values))) + (list (downcase key) + common-lisp-hyperspec-issuex-symbols + #'(lambda (value) + (list (concat common-lisp-hyperspec-root + "Issues/" + value))))))) + (when (= (aref key 0) ?~) + (push (list (substring key 1) + common-lisp-hyperspec-format-characters + #'(lambda (values) + (mapcar #'common-lisp-hyperspec-section values))) + lookups)) + (dolist (lookup lookups) + (let* ((name (car lookup)) + (obarray (cadr lookup)) + (format (car (cddr lookup))) + (symbol (intern-soft name obarray))) + (when (and symbol (boundp symbol)) + (setq urls (nconc urls + (funcall format (symbol-value symbol))))))) + urls)) + +(defun good-symbols (obarray &optional filter) + "Return the list of bound symbols in OBARRAY for which FILTER returns +non-nil; FILTER defaults to always-true if unspecified." + (let ((syms nil)) + (mapatoms (lambda (sym) + (when (and (boundp sym) + (or (not filter) + (funcall filter sym))) + (setq syms (cons sym syms)))) + obarray) + (sort syms #'string<))) + +(defun hyperspec-keys () + "Return the list of all valid hyperspec lookup keys. Useful for +completion." + (nconc (good-symbols common-lisp-hyperspec-symbols) + (mapcar #'(lambda (name) + (format "~%s" name)) + (good-symbols common-lisp-hyperspec-format-characters + #'(lambda (sym) + (= (length (symbol-name sym)) 1)))) + (good-symbols common-lisp-hyperspec-issuex-symbols))) + +;;;-------------------------------------------------------------------------- +;;; Parse the command line. + +(defvar key nil) +(defvar mode 'url) + +(defvar options + '((("-h" "--help") . help) + (("-l" "--list") . (lambda () (setq mode 'list))))) + +(defun help () + (princ usage-string) + (princ " + +Write to stdout a URL to the Hyperspec page describing KEY. + +Options: + -h, --help Show this help message. + -l, --list Write to stdout a list of acceptable KEYS. +") + (kill-emacs)) + +;; Parse the command-line options. +(pop command-line-args-left) +(catch 'done + (while t + (unless command-line-args-left + (throw 'done nil)) + (let ((opt (pop command-line-args-left))) + (cond ((string= opt "--") + (throw 'done nil)) + ((not (eq (aref opt 0) ?-)) + (push opt command-line-args-left) + (throw 'done nil)) + (t + (catch 'found + (dolist (def options) + (when (member opt (car def)) + (funcall (cdr def)) + (throw 'found nil))) + (die "Unknown option `%s'." opt))))))) + +;; Check the non-option arguments. +(cond ((eq mode 'url) + (unless (= (length command-line-args-left) 1) + (die-usage)) + (let* ((key (car command-line-args-left)) + (urls (hyperspec-urls key))) + (mapcar #'(lambda (url) (princ url) (terpri)) urls))) + ((eq mode 'list) + (unless (null command-line-args-left) + (die-usage)) + (mapc (lambda (item) (princ item) (terpri)) + (hyperspec-keys)))) + +;;;----- That's all, folks -------------------------------------------------- diff --git a/setup b/setup index ce31afc..16ef268 100755 --- a/setup +++ b/setup @@ -191,7 +191,8 @@ scripts=" emerge-hack lesspipe.sh start-ssh-agent - svnwrap" + svnwrap + hyperspec" [ "$xstuff" ] && scripts="$scripts xrun xshutdown" -- [mdw]