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)))
48 (setq kill-emacs-hook nil)
50 ;;;--------------------------------------------------------------------------
53 (defvar quis "hyperspec")
55 (defun die (&rest format-args)
56 (message "%s: %s" quis (apply #'format format-args))
59 (defvar usage-string "Usage: hyperspec -l | KEY")
62 (message "%s" usage-string)
65 ;;;--------------------------------------------------------------------------
66 ;;; Look up a string and find its URL in the Hyperspec.
68 (defmacro some-var (&rest vars)
70 `(let ((,v (find-if #'boundp ',vars)))
71 (if ,v (symbol-value ,v)
74 (defun hyperspec-urls (key)
75 "Return a list of hyperspec URLs corresponding to KEY."
77 (lookups (list (list (downcase key)
78 (some-var common-lisp-hyperspec--symbols
79 common-lisp-hyperspec-symbols)
81 (mapcar (lambda (value)
82 (concat common-lisp-hyperspec-root
87 (some-var common-lisp-hyperspec--issuex-symbols
88 common-lisp-hyperspec-issuex-symbols)
90 (list (concat common-lisp-hyperspec-root
93 (when (= (aref key 0) ?~)
94 (push (list (substring key 1)
95 (some-var common-lisp-hyperspec--format-characters
96 common-lisp-hyperspec-format-characters)
98 (mapcar #'common-lisp-hyperspec-section
101 (dolist (lookup lookups)
102 (let* ((name (car lookup))
103 (table (cadr lookup))
104 (format (car (cddr lookup)))
105 (value (cond ((vectorp table)
106 (let ((symbol (intern-soft name table)))
109 (symbol-value symbol))))
110 ((hash-table-p table)
111 (gethash name table))
113 (error "what even?")))))
115 (setq urls (nconc urls (funcall format value))))))
118 (defun good-symbols (table &optional filter)
119 "Return the list of bound symbols in TABLE for which FILTER returns
120 non-nil; FILTER defaults to always-true if unspecified."
122 (cond ((vectorp table)
123 (mapatoms (lambda (sym)
124 (when (and (boundp sym)
126 (funcall filter sym)))
127 (push (symbol-name sym) syms)))
129 ((hash-table-p table)
130 (maphash (lambda (key value)
131 (when (or (not filter) (funcall filter key))
135 (error "what even?")))
136 (sort syms #'string<)))
138 (defun hyperspec-keys ()
139 "Return the list of all valid hyperspec lookup keys. Useful for
141 (nconc (good-symbols (some-var common-lisp-hyperspec--symbols
142 common-lisp-hyperspec-symbols))
143 (mapcar #'(lambda (name)
144 (format "~%c" (aref name 0)))
145 (good-symbols (some-var common-lisp-hyperspec--format-characters
146 common-lisp-hyperspec-format-characters)
148 (and (>= (length name) 3)
150 (let ((ch (aref name 0)))
151 (= ch (downcase ch)))))))
152 (good-symbols (some-var common-lisp-hyperspec--issuex-symbols
153 common-lisp-hyperspec-issuex-symbols))))
155 ;;;--------------------------------------------------------------------------
156 ;;; Parse the command line.
162 '((("-h" "--help") . help)
163 (("-l" "--list") . (lambda () (setq mode 'list)))))
169 Write to stdout a URL to the Hyperspec page describing KEY.
172 -h, --help Show this help message.
173 -l, --list Write to stdout a list of acceptable KEYS.
177 ;; Parse the command-line options.
178 (pop command-line-args-left)
181 (unless command-line-args-left
183 (let ((opt (pop command-line-args-left)))
184 (cond ((string= opt "--")
186 ((not (eq (aref opt 0) ?-))
187 (push opt command-line-args-left)
191 (dolist (def options)
192 (when (member opt (car def))
195 (die "Unknown option `%s'." opt)))))))
197 ;; Check the non-option arguments.
198 (cond ((eq mode 'url)
199 (unless (= (length command-line-args-left) 1)
201 (let* ((key (car command-line-args-left))
202 (urls (hyperspec-urls key)))
203 (mapcar #'(lambda (url) (princ url) (terpri)) urls)))
205 (unless (null command-line-args-left)
207 (mapc (lambda (item) (princ item) (terpri))
210 ;;;----- That's all, folks --------------------------------------------------