|
22
|
1 ; -*- Mode: Emacs-Lisp -*-
|
|
|
2 ;;; browse-cltl2.el --- browse the hypertext-version of
|
|
|
3 ;;; "Common Lisp the Language, 2nd. Edition"
|
|
|
4
|
|
24
|
5 ;; Revision 1.1.2
|
|
|
6 ;; last edited on 18.2.1997
|
|
22
|
7
|
|
|
8 ;; Copyright (C) 1997 Holger Schauer
|
|
|
9
|
|
|
10 ;; Author: Holger Schauer <Holger.Schauer@gmd.de>
|
|
24
|
11 ;; Keywords: utils lisp ilisp www
|
|
22
|
12
|
|
|
13 ;; This file is not part of Emacs.
|
|
|
14
|
|
|
15 ;; Developed under XEmacs 19.14. Also tested on Emacs 19.32 and
|
|
|
16 ;; XEmacs 19.11. Should work with newer versions, too.
|
|
|
17 ;; Required: browse-url.el
|
|
|
18 ;; Recommended: url.el
|
|
|
19
|
|
|
20 ;; This program is free software; you can redistribute it and/or modify
|
|
|
21 ;; it under the terms of the GNU General Public License as published by
|
|
|
22 ;; the Free Software Foundation; either version 2 of the License, or
|
|
|
23 ;; (at your option) any later version.
|
|
|
24 ;;
|
|
|
25 ;; This program is distributed in the hope that it will be useful,
|
|
|
26 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
27 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
28 ;; GNU General Public License for more details.
|
|
|
29 ;;
|
|
|
30 ;; You should have received a copy of the GNU General Public License
|
|
|
31 ;; along with this program; if not, write to the Free Software
|
|
|
32 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
33
|
|
|
34 ;;; Commentary:
|
|
|
35 ;; This gives you two top-level-functions useful when programming lisp:
|
|
|
36 ;; cltl2-view-function-definition and cltl2-view-index
|
|
|
37 ;; cltl2-view-function-definition asks you for a name of a lisp
|
|
|
38 ;; function (or variable) and will open up your favourite browser
|
|
|
39 ;; (as specified by `browse-url-browser-function') loading the page
|
|
|
40 ;; which documents it.
|
|
|
41
|
|
|
42 ;;; Installation: (as usual)
|
|
|
43 ;; Put browse-cltl2.el somewhere where emacs can find it.
|
|
|
44 ;; browse-cltl2.el requires a working browse-url, url and cl.
|
|
|
45 ;; Insert the following lines in your .emacs:
|
|
|
46 ;;
|
|
|
47 ;; (autoload 'cltl2-view-function-definition "browse-cltl2")
|
|
|
48 ;; (autoload 'cltl2-view-index "browse-cltl2")
|
|
|
49 ;; (autoload 'cltl2-lisp-mode-install "browse-cltl2")
|
|
|
50 ;; (add-hook 'lisp-mode-hook 'cltl2-lisp-mode-install)
|
|
|
51 ;; (add-hook 'ilisp-mode-hook 'cltl2-lisp-mode-install)
|
|
|
52 ;;
|
|
|
53 ;; This should also add the needed hooks to lisp-mode (and ilisp-mode).
|
|
|
54
|
|
|
55 ;; Gnu Emacs:
|
|
|
56 ;; For Gnu Emacs there doesn't seem to be a lisp-mode-hook so you're
|
|
|
57 ;; on your own with the key-settings.
|
|
|
58 ;; No url.el:
|
|
|
59 ;; If you don't have url.el set *cltl2-use-url* to nil
|
|
|
60 ;; and set *cltl2-fetch-method* to 'local or 'local-index-only.
|
|
|
61 ;; This implies that you need a local copy of the index page of
|
|
|
62 ;; CLtL2 (which you can get from the normal hypertext-version at CMU),
|
|
|
63 ;; so you need to point *cltl2-local-file-pos* and *cltl2-index-file-name*
|
|
|
64 ;; to the place where you put it.
|
|
|
65 ;; Old versions of Emacs (XEmacs 19.11 for example):
|
|
|
66 ;; When you want to use a local copy (or a local copy of the index file)
|
|
|
67 ;; check the documentation on find-file-noselect. If it doesn't mention
|
|
|
68 ;; an option called RAWFILE set *cltl2-old-find-file-noselect* to 't.
|
|
|
69
|
|
|
70
|
|
|
71 ;;; Customization:
|
|
|
72 ;; By default, browse-cltl2 will use a local copy of CLtL2, looking
|
|
|
73 ;; for it in /usr/doc/html/cltl. This can be modified with the help
|
|
|
74 ;; of the following variables:
|
|
|
75 ;; *cltl2-fetch-method*, *cltl2-url*, *cltl-local-file-pos*
|
|
|
76 ;; See the documentation on this variables for more info.
|
|
|
77 ;;
|
|
|
78 ;;; TODO:
|
|
|
79 ;; In this version we can't separate between functions, variables,
|
|
|
80 ;; constants and loop clauses. This is not that hard to change,
|
|
|
81 ;; but it is more difficult to distinguish what the user is
|
|
|
82 ;; looking for. Until I receive several requests for it, I won't
|
|
|
83 ;; implement it, because there are not that much constructs like * and +
|
|
|
84 ;; which have two (or more) semantics.
|
|
|
85
|
|
|
86 ;;; Changes:
|
|
|
87 ;; 28-01-97: HS: now we're using cl-puthash all over the place because
|
|
|
88 ;; this is common on XEmacs 19.11 and upwards and Gnu Emacs.
|
|
|
89 ;; Added information on how to install without url.el
|
|
|
90 ;;
|
|
|
91 ;; 29-01-97 HS: included conditionalized versions of the required
|
|
|
92 ;; functions match-string and buffer-live-p.
|
|
|
93 ;; Suggested by Simon Marshall <Simon.Marshall@esrin.esa.it>.
|
|
|
94 ;; Included new variable *cltl2-use-url* with which one can
|
|
|
95 ;; specify if he has url.el or not. Introduced variable
|
|
24
|
96 ;; *cltl2-old-find-file-noselect*.
|
|
|
97 ;;
|
|
|
98 ;; 05-02-97 HS: added two variables for the key-bindings,
|
|
|
99 ;; *cltl2-vfd-key* *cltl2-vi-key*.
|
|
|
100 ;;
|
|
|
101 ;; 18-02-97 HS: use compatible keybindings that work on Gnu Emacs and XEmacs.
|
|
|
102 ;; Made cltl2-lisp-mode-install an interactive function.
|
|
22
|
103 (defvar *cltl2-use-url* 'nil
|
|
|
104 "Enables or disables retrieval of the index-file via WWW (or more
|
|
|
105 exactly by the use of the function url-retrieve from url.el).
|
|
|
106 Default is 't.")
|
|
|
107
|
|
|
108 ;; needed things
|
|
|
109 (require 'cl)
|
|
|
110 (require 'browse-url)
|
|
|
111
|
|
|
112 (when (not *cltl2-use-url*)
|
|
|
113 (require 'url))
|
|
|
114
|
|
|
115 ;;; ******************************
|
|
|
116 ;;; Some variable and constant definitions
|
|
|
117 ;;; ******************************
|
|
|
118 (defvar *cltl2-fetch-method* 'local
|
|
|
119 "This sets the method by which the index-file will be fetched. Three
|
|
|
120 methods are possible: 'local assumes that all files are local.
|
|
|
121 'local-index-only assumes that just the index-file is locally but
|
|
|
122 all other files will be fetched via www. 'www means that the index-file
|
|
|
123 will be fetched via WWW, too. Don't change the value of this variable
|
|
|
124 after loading.")
|
|
|
125
|
|
|
126 (defvar *cltl2-url*
|
|
|
127 "http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/"
|
|
|
128 "The url where the hypertext-version of Common Lisp the Language
|
|
|
129 can be found. Note that this assumes to be the top-level of the
|
|
|
130 directory structure which should be the same as in the hypertext
|
|
|
131 version as provided by the CMU AI Repository. Defaults to
|
|
|
132 http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/
|
|
|
133 Note the / at the end.")
|
|
|
134
|
|
|
135 (defvar *cltl2-local-file-pos* "/usr/doc/html/cltl/"
|
|
|
136 "A directory where the CLtl2 can be found. Note that this assumes
|
|
|
137 to be the top-level of the directory structure which should be the
|
|
|
138 same as in the hypertext version as provided by the CMU AI Repository.
|
|
|
139 Defaults to /usr/doc/html/cltl/ Note the / at the end.")
|
|
|
140
|
|
|
141 (defconst *cltl2-index-file-name* "clm/index.html"
|
|
|
142 "The name of the index-file, typically with directory on front.
|
|
|
143 Defaults to clm/index.html, as this is the momentary position from
|
|
|
144 the top-level directory of the CLtL2-home. Defaults to clm/index.html.
|
|
|
145 Note that there is no leading /.")
|
|
|
146
|
|
|
147 (defvar *cltl2-index-home*
|
|
|
148 (concatenate 'string
|
|
|
149 (case *cltl2-fetch-method*
|
|
|
150 ('local *cltl2-local-file-pos*)
|
|
|
151 ('local-index-only *cltl2-local-file-pos*)
|
|
|
152 ('www *cltl2-url*))
|
|
|
153 *cltl2-index-file-name*)
|
|
|
154 "The absolute path which will be used to fetch the index.")
|
|
|
155
|
|
|
156 (defvar *cltl2-home*
|
|
|
157 (concatenate
|
|
|
158 'string
|
|
|
159 (case *cltl2-fetch-method*
|
|
|
160 ('local *cltl2-local-file-pos*)
|
|
|
161 ('local-index-only *cltl2-url*)
|
|
|
162 ('www *cltl2-url*))
|
|
|
163 "clm/")
|
|
|
164 "This specifies the home-position of the CLtL2. The value of this variable
|
|
|
165 will be concatenated with the name of the nodes of the CLtL2.")
|
|
|
166
|
|
|
167 (defvar *cltl2-index-buffer-name* "*cltl2-index*"
|
|
|
168 "The name of the buffer which holds the index for CLtL2.")
|
|
|
169
|
|
|
170 (defvar *cltl2-old-find-file-noselect* 'nil
|
|
|
171 "Older versions of Emacs (at least XEmacs 19.11) don't support the
|
|
|
172 option RAWFILE with the function FIND-FILE-NO-SELECT. Set this variable
|
|
|
173 to 't if you have such an old version. It will cause fontification and
|
|
|
174 other useless stuff on the buffer in which the index is fetched. If
|
|
|
175 you don't use a local copy (of the index) this won't bother you.")
|
|
|
176
|
|
24
|
177 (defvar *cltl2-vfd-key*
|
|
|
178 (if (featurep 'ilisp)
|
|
|
179 '[(control z) h]
|
|
|
180 '[(control c) b])
|
|
|
181 "Shortcut for accessing cltl2-view-function-definition. Use meaningful
|
|
|
182 setting with Ilisp.")
|
|
|
183
|
|
|
184 (defvar *cltl2-vi-key*
|
|
|
185 (if (featurep 'ilisp)
|
|
|
186 '[(control z) H]
|
|
|
187 '[(control c) B])
|
|
|
188 "Shortcut for accessing cltl2-view-index. Use meaningful
|
|
|
189 setting with Ilisp.")
|
|
|
190
|
|
22
|
191 (defvar *browse-cltl2-ht* (make-hash-table 0))
|
|
|
192 (defconst *cltl2-search-regexpr*
|
|
|
193 "<a href=\"\\(.+\\)\"><code>\\(.+\\)</code></a>"
|
|
|
194 "A regular expression how to check for entries in the index-file
|
|
|
195 of CLtL2. Note that you have to modify this and the
|
|
|
196 prepare-get-entry*-functions if you want to change the search.")
|
|
|
197
|
|
|
198 ;;; ******************************
|
|
|
199 ;;; First of all: Compatibility stuff
|
|
|
200 ;;; ******************************
|
|
|
201 ; no match-string in old versions
|
|
|
202 (if (not (fboundp (function match-string)))
|
|
|
203 (defun match-string (num &optional string)
|
|
|
204 "Return string of text matched by last search.
|
|
|
205 NUM specifies which parenthesized expression in the last regexp.
|
|
|
206 Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
|
|
|
207 Zero means the entire text matched by the whole regexp or whole string.
|
|
|
208 STRING should be given if the last search was by `string-match' on STRING."
|
|
|
209 (if (match-beginning num)
|
|
|
210 (if string
|
|
|
211 (substring string (match-beginning num) (match-end num))
|
|
|
212 (buffer-substring
|
|
|
213 (match-beginning num) (match-end num))))))
|
|
|
214
|
|
|
215 ; no buffer-live-p in old versions
|
|
|
216 (if (not (fboundp (function buffer-live-p)))
|
|
|
217 (defun buffer-live-p (buf-or-name)
|
|
|
218 "Checks if BUF-OR-NAME is a live buffer. Returns non-nil
|
|
|
219 if BOF-OR-NAME is an editor buffer which has not been deleted.
|
|
|
220 Imitating a built-in function from newer Emacs versions."
|
|
|
221 (let ((object (if (bufferp buf-or-name)
|
|
|
222 buf-or-name
|
|
|
223 (get-buffer buf-or-name))))
|
|
|
224 (and (bufferp object) (buffer-name object)))))
|
|
|
225
|
|
|
226 ; no add-submenu in old versions of XEmacs
|
|
|
227 (if (and (string-match "XEmacs\\|Lucid" emacs-version)
|
|
|
228 (not (fboundp 'add-submenu)))
|
|
|
229 (defun add-submenu (menu-path submenu &optional before)
|
|
|
230 "Add a menu to the menubar or one of its submenus.
|
|
|
231 If the named menu exists already, it is changed.
|
|
|
232 MENU-PATH identifies the menu under which the new menu should be inserted.
|
|
|
233 It is a list of strings; for example, (\"File\") names the top-level \"File\"
|
|
|
234 menu. (\"File\" \"Foo\") names a hypothetical submenu of \"File\".
|
|
|
235 If MENU-PATH is nil, then the menu will be added to the menubar itself.
|
|
|
236 SUBMENU is the new menu to add.
|
|
|
237 See the documentation of `current-menubar' for the syntax.
|
|
|
238 BEFORE, if provided, is the name of a menu before which this menu should
|
|
|
239 be added, if this menu is not on its parent already. If the menu is already
|
|
|
240 present, it will not be moved."
|
|
|
241 (add-menu menu-path (car submenu) (cdr submenu) before)))
|
|
|
242
|
|
|
243 ; old find-file-noselect has no RAWFILE argument
|
|
|
244 (if *cltl2-old-find-file-noselect*
|
|
|
245 (unless (boundp 'cltl2-old-find-file-noselect-func)
|
|
|
246 (setf (symbol-value 'cltl2-old-find-file-noselect-func)
|
|
|
247 (symbol-function 'find-file-noselect))
|
|
|
248 (setf (symbol-function 'find-file-noselect)
|
|
|
249 #'(lambda (file &optional nowarn rawfile)
|
|
|
250 (funcall cltl2-old-find-file-noselect-func file nowarn)))))
|
|
|
251
|
|
|
252 ;;; ******************************
|
|
|
253 ;;; Functions for fetching the index file
|
|
|
254 ;;; ******************************
|
|
|
255 (defun cltl2-fetch-index ()
|
|
|
256 "Fetches the index page of the CLtl2 and puts it in its own
|
|
|
257 buffer called *cltl2-index*."
|
|
|
258 ;; if the index isn't here load it into a buffer
|
|
|
259 (when (or (not (get-buffer *cltl2-index-buffer-name*))
|
|
|
260 (not (buffer-live-p *cltl2-index-buffer-name*)))
|
|
|
261 (message "Fetching the CLtL2 index file ...")
|
|
|
262 (case *cltl2-fetch-method*
|
|
|
263 ('local
|
|
|
264 (cltl2-fetch-index-by-file))
|
|
|
265 ('local-index-only
|
|
|
266 (cltl2-fetch-index-by-file))
|
|
|
267 ('www
|
|
|
268 (cltl2-fetch-index-by-www))))
|
|
|
269
|
|
|
270 (cltl2-prepare-index)
|
|
|
271 )
|
|
|
272
|
|
|
273 ;; fetch methods
|
|
|
274 (defun cltl2-fetch-index-by-file ()
|
|
|
275 "Fetch the index from disk."
|
|
|
276 (setf *cltl2-index-buffer-name*
|
|
|
277 (find-file-noselect *cltl2-index-home* 'nil 't))
|
|
|
278 )
|
|
|
279
|
|
|
280 (defun cltl2-fetch-index-by-www ()
|
|
|
281 "Fetch the index via WWW."
|
|
|
282 (save-excursion
|
|
|
283 (let ((old-url-working-buffer url-working-buffer))
|
|
|
284 (setf url-working-buffer *cltl2-index-buffer-name*)
|
|
|
285 (url-retrieve *cltl2-index-home*)
|
|
|
286 (setf url-working-buffer old-url-working-buffer))))
|
|
|
287
|
|
|
288
|
|
|
289 ;;; ******************************
|
|
|
290 ;;; Main functions for viewing
|
|
|
291 ;;; ******************************
|
|
|
292 (defun cltl2-view-function-definition (entry)
|
|
|
293 "First checks if function can be found in the CLtL2-index-file.
|
|
|
294 If it can be found, uses the function browse-url to have a look
|
|
|
295 at the corresponding documentation from CLtL2."
|
|
|
296 (interactive "sCLtL2-Entry to lookup:")
|
|
|
297 (when (cltl2-index-unprepared-p)
|
|
|
298 (cltl2-fetch-index))
|
|
|
299
|
|
|
300 (let ((entry-url (cltl2-find-url-for-function (intern entry))))
|
|
|
301 (when entry-url
|
|
|
302 (message "Loading found entry for %s into browser.." entry)
|
|
|
303 (browse-url
|
|
|
304 (concatenate 'string *cltl2-home* entry-url)))))
|
|
|
305
|
|
|
306 (defun cltl2-find-url-for-function (entry)
|
|
|
307 "Checks if we can find a page for function ENTRY and
|
|
|
308 constructs an URL from it."
|
|
|
309 (let ((entry-url (gethash entry *browse-cltl2-ht*)))
|
|
|
310 (when (not entry-url)
|
|
|
311 (error "No entry in CLtL2 for %s" entry))
|
|
|
312 entry-url))
|
|
|
313
|
|
|
314 (defun cltl2-view-index ()
|
|
|
315 "Browse-urls the index file."
|
|
|
316 (interactive)
|
|
|
317 (browse-url *cltl2-index-home*))
|
|
|
318
|
|
|
319 ;;; ******************************
|
|
|
320 ;;; Preparing the index (the hashtable)
|
|
|
321 ;;; ******************************
|
|
|
322 (defun cltl2-prepare-index ()
|
|
|
323 "Jumps to the *cltl2-index* buffer and scans it, creating a hashtable
|
|
|
324 for all entries."
|
|
|
325 (message "Preparing CLtL2 index.")
|
|
|
326 (save-excursion
|
|
|
327 (set-buffer *cltl2-index-buffer-name*)
|
|
|
328 (goto-char (point-min))
|
|
|
329
|
|
|
330 ; search for entry
|
|
|
331 (do ((point (re-search-forward
|
|
|
332 *cltl2-search-regexpr*
|
|
|
333 nil t)
|
|
|
334 (re-search-forward
|
|
|
335 *cltl2-search-regexpr*
|
|
|
336 nil t)))
|
|
|
337 ; until we can't find anymore
|
|
|
338 ((null point)); (format "Index-preparation done."))
|
|
|
339 ; put found entry in hash-table
|
|
|
340 (cl-puthash
|
|
|
341 (cltl2-prepare-get-entry-name)
|
|
|
342 (cltl2-prepare-get-entry-url)
|
|
|
343 *browse-cltl2-ht*))))
|
|
|
344
|
|
|
345 (defun cltl2-prepare-get-entry-name ()
|
|
|
346 "Get the enrty name from the last match of regexp-search for entries."
|
|
|
347 (let ((name-string (intern (match-string 2))))
|
|
|
348 (format "%s" name-string)
|
|
|
349 name-string))
|
|
|
350
|
|
|
351 (defun cltl2-prepare-get-entry-url ()
|
|
|
352 "Get the enrty url from the last match of regexp-search for entries."
|
|
|
353 (let ((url (match-string 1)))
|
|
|
354 (format "%s" url)
|
|
|
355 url))
|
|
|
356
|
|
|
357 (defun cltl2-index-unprepared-p ()
|
|
|
358 "Check if the index is already prepared."
|
|
|
359 ; If the hashtable has entries the index is prepared.
|
|
|
360 (not (and (hash-table-p *browse-cltl2-ht*)
|
|
|
361 (>= (hash-table-count *browse-cltl2-ht*) 1))))
|
|
|
362
|
|
|
363 ;;; ******************************
|
|
|
364 ;;; Hooking into lisp mode and ilisp-mode
|
|
|
365 ;;; ******************************
|
|
|
366 (defun cltl2-lisp-mode-install ()
|
|
24
|
367 "Adds browse-cltl2 to lisp-mode. If you use ilisp (installed via a hook
|
|
|
368 on lisp-mode) add browse-cltl2 to ilisp. Check the variables *cltl2-vfd-key*
|
|
|
369 and *cltl2-vi-key* for the keybindings. Under XEmacs we will add ourself to
|
|
|
370 the corresponding menus if there exists one."
|
|
|
371 (interactive)
|
|
22
|
372 ; set key bindings
|
|
24
|
373 (local-set-key *cltl2-vfd-key* 'cltl2-view-function-definition)
|
|
|
374 (local-set-key *cltl2-vi-key* 'cltl2-view-index)
|
|
22
|
375 ; under XEmacs hook ourself into the menu if there is one
|
|
|
376 (when (string-match "XEmacs\\|Lucid" emacs-version)
|
|
24
|
377 (cond ((and (featurep 'ilisp-easy-menu)
|
|
|
378 ; this is for the menu as provided by ilisp-easy-menu
|
|
|
379 (not (null (car (find-menu-item current-menubar '("ILisp"))))))
|
|
22
|
380 (add-submenu
|
|
|
381 '("ILisp" "Documentation")
|
|
|
382 '("Browse CLtL2"
|
|
|
383 [ "View entry" cltl2-view-function-definition t]
|
|
|
384 [ "View index" cltl2-view-index t] )))
|
|
24
|
385 ; perhaps an other Ilisp-Menu is there ?
|
|
|
386 ((not (null (car (find-menu-item current-menubar '("ILisp")))))
|
|
|
387 (add-submenu
|
|
|
388 '("Lisp")
|
|
|
389 '("Browse CLtL2"
|
|
|
390 [ "View entry" cltl2-view-function-definition t]
|
|
|
391 [ "View index" cltl2-view-index t] )))
|
|
|
392 ; or at least a Lisp-Menu ?
|
|
22
|
393 ((not (null (car (find-menu-item current-menubar '("Lisp")))))
|
|
|
394 (add-submenu
|
|
|
395 '("Lisp")
|
|
|
396 '("Browse CLtL2"
|
|
|
397 [ "View entry" cltl2-view-function-definition t]
|
|
|
398 [ "View index" cltl2-view-index t] )))))
|
|
|
399 )
|
|
|
400
|
|
|
401 (add-hook 'lisp-mode-hook 'cltl2-lisp-mode-install)
|
|
|
402 (add-hook 'ilisp-mode-hook 'cltl2-lisp-mode-install)
|
|
|
403
|
|
|
404 ;;; Providing ourself.
|
|
|
405 (provide 'ilisp-browse-cltl2)
|
|
|
406 ;;; browse-cltl2.el ends here.
|
