+#! /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 --------------------------------------------------
~mdw / profile / commitdiff