Commit | Line | Data |
---|---|---|
4cdeb0d0 MW |
1 | #! /bin/sh |
2 | '': "-*-emacs-lisp-*-"; exec emacs --no-site-file --batch --load "$0" -- "$@" | |
3 | ;;; | |
4 | ;;; Look things up in the Common Lisp Hyperspec. | |
5 | ;;; | |
6 | ;;; (c) 2008 Mark Wooding | |
7 | ;;; | |
8 | ||
9 | ;;;----- Licensing notice --------------------------------------------------- | |
10 | ;;; | |
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. | |
15 | ;;; | |
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. | |
20 | ;;; | |
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 | |
24 | ||
25 | ;;;-------------------------------------------------------------------------- | |
26 | ;;; External dependencies. | |
27 | ||
28 | ;; We need the hyperspec library, obviously. | |
29 | (require 'hyperspec) | |
30 | ||
31 | ;; The init file probably has customizations for the Hyperspec library, in | |
32 | ;; particular where the local Hyperspec files are. | |
33 | ;; | |
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))) | |
38 | (unwind-protect | |
39 | (progn | |
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." | |
44 | signal)))) | |
45 | (fset 'message original-message))) | |
46 | ||
b958e20c MW |
47 | ;; No. |
48 | (setq kill-emacs-hook nil) | |
49 | ||
4cdeb0d0 MW |
50 | ;;;-------------------------------------------------------------------------- |
51 | ;;; Utilities. | |
52 | ||
53 | (defvar quis "hyperspec") | |
54 | ||
55 | (defun die (&rest format-args) | |
56 | (message "%s: %s" quis (apply #'format format-args)) | |
57 | (kill-emacs 1)) | |
58 | ||
59 | (defvar usage-string "Usage: hyperspec -l | KEY") | |
60 | ||
61 | (defun die-usage () | |
62 | (message "%s" usage-string) | |
63 | (kill-emacs 1)) | |
64 | ||
65 | ;;;-------------------------------------------------------------------------- | |
66 | ;;; Look up a string and find its URL in the Hyperspec. | |
67 | ||
b958e20c MW |
68 | (defmacro some-var (&rest vars) |
69 | (let ((v (gensym))) | |
70 | `(let ((,v (find-if #'boundp ',vars))) | |
71 | (if ,v (symbol-value ,v) | |
72 | (error "huh"))))) | |
73 | ||
4cdeb0d0 MW |
74 | (defun hyperspec-urls (key) |
75 | "Return a list of hyperspec URLs corresponding to KEY." | |
76 | (let ((urls nil) | |
77 | (lookups (list (list (downcase key) | |
b958e20c MW |
78 | (some-var common-lisp-hyperspec--symbols |
79 | common-lisp-hyperspec-symbols) | |
4cdeb0d0 MW |
80 | #'(lambda (values) |
81 | (mapcar (lambda (value) | |
82 | (concat common-lisp-hyperspec-root | |
83 | "Body/" | |
84 | value)) | |
85 | values))) | |
86 | (list (downcase key) | |
b958e20c MW |
87 | (some-var common-lisp-hyperspec--issuex-symbols |
88 | common-lisp-hyperspec-issuex-symbols) | |
4cdeb0d0 MW |
89 | #'(lambda (value) |
90 | (list (concat common-lisp-hyperspec-root | |
91 | "Issues/" | |
92 | value))))))) | |
93 | (when (= (aref key 0) ?~) | |
94 | (push (list (substring key 1) | |
b958e20c MW |
95 | (some-var common-lisp-hyperspec--format-characters |
96 | common-lisp-hyperspec-format-characters) | |
4cdeb0d0 | 97 | #'(lambda (values) |
b958e20c MW |
98 | (mapcar #'common-lisp-hyperspec-section |
99 | values))) | |
4cdeb0d0 MW |
100 | lookups)) |
101 | (dolist (lookup lookups) | |
102 | (let* ((name (car lookup)) | |
b958e20c | 103 | (table (cadr lookup)) |
4cdeb0d0 | 104 | (format (car (cddr lookup))) |
b958e20c MW |
105 | (value (cond ((vectorp table) |
106 | (let ((symbol (intern-soft name table))) | |
107 | (and symbol | |
108 | (boundp symbol) | |
109 | (symbol-value symbol)))) | |
110 | ((hash-table-p table) | |
111 | (gethash name table)) | |
112 | (t | |
113 | (error "what even?"))))) | |
114 | (when value | |
115 | (setq urls (nconc urls (funcall format value)))))) | |
4cdeb0d0 MW |
116 | urls)) |
117 | ||
b958e20c MW |
118 | (defun good-symbols (table &optional filter) |
119 | "Return the list of bound symbols in TABLE for which FILTER returns | |
4cdeb0d0 MW |
120 | non-nil; FILTER defaults to always-true if unspecified." |
121 | (let ((syms nil)) | |
b958e20c MW |
122 | (cond ((vectorp table) |
123 | (mapatoms (lambda (sym) | |
124 | (when (and (boundp sym) | |
125 | (or (not filter) | |
126 | (funcall filter sym))) | |
127 | (push (symbol-name sym) syms))) | |
128 | table)) | |
129 | ((hash-table-p table) | |
130 | (maphash (lambda (key value) | |
131 | (when (or (not filter) (funcall filter key)) | |
132 | (push key syms))) | |
133 | table)) | |
134 | (t | |
135 | (error "what even?"))) | |
4cdeb0d0 MW |
136 | (sort syms #'string<))) |
137 | ||
138 | (defun hyperspec-keys () | |
139 | "Return the list of all valid hyperspec lookup keys. Useful for | |
140 | completion." | |
b958e20c MW |
141 | (nconc (good-symbols (some-var common-lisp-hyperspec--symbols |
142 | common-lisp-hyperspec-symbols)) | |
4cdeb0d0 | 143 | (mapcar #'(lambda (name) |
b958e20c MW |
144 | (format "~%c" (aref name 0))) |
145 | (good-symbols (some-var common-lisp-hyperspec--format-characters | |
146 | common-lisp-hyperspec-format-characters) | |
147 | #'(lambda (name) | |
148 | (and (>= (length name) 3) | |
149 | (= (aref name 2) ?-) | |
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)))) | |
4cdeb0d0 MW |
154 | |
155 | ;;;-------------------------------------------------------------------------- | |
156 | ;;; Parse the command line. | |
157 | ||
158 | (defvar key nil) | |
159 | (defvar mode 'url) | |
160 | ||
161 | (defvar options | |
162 | '((("-h" "--help") . help) | |
163 | (("-l" "--list") . (lambda () (setq mode 'list))))) | |
164 | ||
165 | (defun help () | |
166 | (princ usage-string) | |
167 | (princ " | |
168 | ||
169 | Write to stdout a URL to the Hyperspec page describing KEY. | |
170 | ||
171 | Options: | |
172 | -h, --help Show this help message. | |
173 | -l, --list Write to stdout a list of acceptable KEYS. | |
174 | ") | |
175 | (kill-emacs)) | |
176 | ||
177 | ;; Parse the command-line options. | |
178 | (pop command-line-args-left) | |
179 | (catch 'done | |
180 | (while t | |
181 | (unless command-line-args-left | |
182 | (throw 'done nil)) | |
183 | (let ((opt (pop command-line-args-left))) | |
184 | (cond ((string= opt "--") | |
185 | (throw 'done nil)) | |
186 | ((not (eq (aref opt 0) ?-)) | |
187 | (push opt command-line-args-left) | |
188 | (throw 'done nil)) | |
189 | (t | |
190 | (catch 'found | |
191 | (dolist (def options) | |
192 | (when (member opt (car def)) | |
193 | (funcall (cdr def)) | |
194 | (throw 'found nil))) | |
195 | (die "Unknown option `%s'." opt))))))) | |
196 | ||
197 | ;; Check the non-option arguments. | |
198 | (cond ((eq mode 'url) | |
199 | (unless (= (length command-line-args-left) 1) | |
200 | (die-usage)) | |
201 | (let* ((key (car command-line-args-left)) | |
202 | (urls (hyperspec-urls key))) | |
203 | (mapcar #'(lambda (url) (princ url) (terpri)) urls))) | |
204 | ((eq mode 'list) | |
205 | (unless (null command-line-args-left) | |
206 | (die-usage)) | |
207 | (mapc (lambda (item) (princ item) (terpri)) | |
208 | (hyperspec-keys)))) | |
209 | ||
210 | ;;;----- That's all, folks -------------------------------------------------- |