#! /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 --------------------------------------------------