2 '': "-*-emacs-lisp-*-"; exec emacs --no-site-file --batch --load "$0" -- "$@"
4 ;;; Look things up in the Common Lisp Hyperspec.
6 ;;; (c) 2008 Mark Wooding
9 ;;;----- Licensing notice ---------------------------------------------------
11 ;;; This program is free software; you can redistribute it and/or modify
12 ;;; it under the terms of the GNU General Public License as published by
13 ;;; the Free Software Foundation; either version 2 of the License, or
14 ;;; (at your option) any later version.
16 ;;; This program is distributed in the hope that it will be useful,
17 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;;; GNU General Public License for more details.
21 ;;; You should have received a copy of the GNU General Public License
22 ;;; along with this program; if not, write to the Free Software
23 ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
25 ;;;--------------------------------------------------------------------------
26 ;;; External dependencies.
28 ;; We need the hyperspec library, obviously.
31 ;; The init file probably has customizations for the Hyperspec library, in
32 ;; particular where the local Hyperspec files are.
34 ;; Hacking here to suppress messages from the init file, and also to protect
35 ;; us from errors in it.
36 (setq mdw-fast-startup t)
37 (let ((original-message (symbol-function 'message)))
40 (fset 'message #'(lambda (&rest hunoz) nil))
41 (condition-case signal (load-file "~/.emacs")
42 (error (funcall original-message
43 "hyperspec (warning): .emacs erred: %s."
45 (fset 'message original-message)))
47 ;;;--------------------------------------------------------------------------
50 (defvar quis "hyperspec")
52 (defun die (&rest format-args)
53 (message "%s: %s" quis (apply #'format format-args))
56 (defvar usage-string "Usage: hyperspec -l | KEY")
59 (message "%s" usage-string)
62 ;;;--------------------------------------------------------------------------
63 ;;; Look up a string and find its URL in the Hyperspec.
65 (defun hyperspec-urls (key)
66 "Return a list of hyperspec URLs corresponding to KEY."
68 (lookups (list (list (downcase key)
69 common-lisp-hyperspec-symbols
71 (mapcar (lambda (value)
72 (concat common-lisp-hyperspec-root
77 common-lisp-hyperspec-issuex-symbols
79 (list (concat common-lisp-hyperspec-root
82 (when (= (aref key 0) ?~)
83 (push (list (substring key 1)
84 common-lisp-hyperspec-format-characters
86 (mapcar #'common-lisp-hyperspec-section values)))
88 (dolist (lookup lookups)
89 (let* ((name (car lookup))
90 (obarray (cadr lookup))
91 (format (car (cddr lookup)))
92 (symbol (intern-soft name obarray)))
93 (when (and symbol (boundp symbol))
94 (setq urls (nconc urls
95 (funcall format (symbol-value symbol)))))))
98 (defun good-symbols (obarray &optional filter)
99 "Return the list of bound symbols in OBARRAY for which FILTER returns
100 non-nil; FILTER defaults to always-true if unspecified."
102 (mapatoms (lambda (sym)
103 (when (and (boundp sym)
105 (funcall filter sym)))
106 (setq syms (cons sym syms))))
108 (sort syms #'string<)))
110 (defun hyperspec-keys ()
111 "Return the list of all valid hyperspec lookup keys. Useful for
113 (nconc (good-symbols common-lisp-hyperspec-symbols)
114 (mapcar #'(lambda (name)
116 (good-symbols common-lisp-hyperspec-format-characters
118 (= (length (symbol-name sym)) 1))))
119 (good-symbols common-lisp-hyperspec-issuex-symbols)))
121 ;;;--------------------------------------------------------------------------
122 ;;; Parse the command line.
128 '((("-h" "--help") . help)
129 (("-l" "--list") . (lambda () (setq mode 'list)))))
135 Write to stdout a URL to the Hyperspec page describing KEY.
138 -h, --help Show this help message.
139 -l, --list Write to stdout a list of acceptable KEYS.
143 ;; Parse the command-line options.
144 (pop command-line-args-left)
147 (unless command-line-args-left
149 (let ((opt (pop command-line-args-left)))
150 (cond ((string= opt "--")
152 ((not (eq (aref opt 0) ?-))
153 (push opt command-line-args-left)
157 (dolist (def options)
158 (when (member opt (car def))
161 (die "Unknown option `%s'." opt)))))))
163 ;; Check the non-option arguments.
164 (cond ((eq mode 'url)
165 (unless (= (length command-line-args-left) 1)
167 (let* ((key (car command-line-args-left))
168 (urls (hyperspec-urls key)))
169 (mapcar #'(lambda (url) (princ url) (terpri)) urls)))
171 (unless (null command-line-args-left)
173 (mapc (lambda (item) (princ item) (terpri))
176 ;;;----- That's all, folks --------------------------------------------------