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