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
--------------------------------------------------