chiark / gitweb /
dot/e16-bindings, bin/media-keys: Keybindings for media players.
[profile] / bin / hyperspec
CommitLineData
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
47;;;--------------------------------------------------------------------------
48;;; Utilities.
49
50(defvar quis "hyperspec")
51
52(defun die (&rest format-args)
53 (message "%s: %s" quis (apply #'format format-args))
54 (kill-emacs 1))
55
56(defvar usage-string "Usage: hyperspec -l | KEY")
57
58(defun die-usage ()
59 (message "%s" usage-string)
60 (kill-emacs 1))
61
62;;;--------------------------------------------------------------------------
63;;; Look up a string and find its URL in the Hyperspec.
64
65(defun hyperspec-urls (key)
66 "Return a list of hyperspec URLs corresponding to KEY."
67 (let ((urls nil)
68 (lookups (list (list (downcase key)
69 common-lisp-hyperspec-symbols
70 #'(lambda (values)
71 (mapcar (lambda (value)
72 (concat common-lisp-hyperspec-root
73 "Body/"
74 value))
75 values)))
76 (list (downcase key)
77 common-lisp-hyperspec-issuex-symbols
78 #'(lambda (value)
79 (list (concat common-lisp-hyperspec-root
80 "Issues/"
81 value)))))))
82 (when (= (aref key 0) ?~)
83 (push (list (substring key 1)
84 common-lisp-hyperspec-format-characters
85 #'(lambda (values)
86 (mapcar #'common-lisp-hyperspec-section values)))
87 lookups))
88 (dolist (lookup lookups)
89 (let* ((name (car lookup))
90 (obarray (cadr lookup))
91 (format (car (cddr lookup)))
92 (symbol (intern-soft name obarray)))
774362e0 93 (when (and symbol (boundp symbol))
4cdeb0d0
MW
94 (setq urls (nconc urls
95 (funcall format (symbol-value symbol)))))))
96 urls))
97
98(defun good-symbols (obarray &optional filter)
99 "Return the list of bound symbols in OBARRAY for which FILTER returns
100non-nil; FILTER defaults to always-true if unspecified."
101 (let ((syms nil))
102 (mapatoms (lambda (sym)
103 (when (and (boundp sym)
104 (or (not filter)
105 (funcall filter sym)))
106 (setq syms (cons sym syms))))
107 obarray)
108 (sort syms #'string<)))
109
110(defun hyperspec-keys ()
111 "Return the list of all valid hyperspec lookup keys. Useful for
112completion."
113 (nconc (good-symbols common-lisp-hyperspec-symbols)
114 (mapcar #'(lambda (name)
115 (format "~%s" name))
116 (good-symbols common-lisp-hyperspec-format-characters
117 #'(lambda (sym)
118 (= (length (symbol-name sym)) 1))))
119 (good-symbols common-lisp-hyperspec-issuex-symbols)))
120
121;;;--------------------------------------------------------------------------
122;;; Parse the command line.
123
124(defvar key nil)
125(defvar mode 'url)
126
127(defvar options
128 '((("-h" "--help") . help)
129 (("-l" "--list") . (lambda () (setq mode 'list)))))
130
131(defun help ()
132 (princ usage-string)
133 (princ "
134
135Write to stdout a URL to the Hyperspec page describing KEY.
136
137Options:
138 -h, --help Show this help message.
139 -l, --list Write to stdout a list of acceptable KEYS.
140")
141 (kill-emacs))
142
143;; Parse the command-line options.
144(pop command-line-args-left)
145(catch 'done
146 (while t
147 (unless command-line-args-left
148 (throw 'done nil))
149 (let ((opt (pop command-line-args-left)))
150 (cond ((string= opt "--")
151 (throw 'done nil))
152 ((not (eq (aref opt 0) ?-))
153 (push opt command-line-args-left)
154 (throw 'done nil))
155 (t
156 (catch 'found
157 (dolist (def options)
158 (when (member opt (car def))
159 (funcall (cdr def))
160 (throw 'found nil)))
161 (die "Unknown option `%s'." opt)))))))
162
163;; Check the non-option arguments.
164(cond ((eq mode 'url)
165 (unless (= (length command-line-args-left) 1)
166 (die-usage))
167 (let* ((key (car command-line-args-left))
168 (urls (hyperspec-urls key)))
169 (mapcar #'(lambda (url) (princ url) (terpri)) urls)))
170 ((eq mode 'list)
171 (unless (null command-line-args-left)
172 (die-usage))
173 (mapc (lambda (item) (princ item) (terpri))
174 (hyperspec-keys))))
175
176;;;----- That's all, folks --------------------------------------------------