|
22
|
1 ; -*- Mode: Emacs-Lisp -*-
|
|
|
2 ;;; browse-cltl2.el --- browse the hypertext-version of
|
|
|
3 ;;; "Common Lisp the Language, 2nd. Edition"
|
|
|
4
|
|
|
5 ;; Revision 1.1.1
|
|
|
6 ;; last edited on 29.1.1997
|
|
|
7
|
|
|
8 ;; Copyright (C) 1997 Holger Schauer
|
|
|
9
|
|
|
10 ;; Author: Holger Schauer <Holger.Schauer@gmd.de>
|
|
|
11 ;; Keywords: utils lisp ilisp
|
|
|
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
|
|
|
96 ;; *cltl2-old-find-file-noselect*.
|
|
|
97 (defvar *cltl2-use-url* 'nil
|
|
|
98 "Enables or disables retrieval of the index-file via WWW (or more
|
|
|
99 exactly by the use of the function url-retrieve from url.el).
|
|
|
100 Default is 't.")
|
|
|
101
|
|
|
102 ;; needed things
|
|
|
103 (require 'cl)
|
|
|
104 (require 'browse-url)
|
|
|
105
|
|
|
106 (when (not *cltl2-use-url*)
|
|
|
107 (require 'url))
|
|
|
108
|
|
|
109 ;;; ******************************
|
|
|
110 ;;; Some variable and constant definitions
|
|
|
111 ;;; ******************************
|
|
|
112 (defvar *cltl2-fetch-method* 'local
|
|
|
113 "This sets the method by which the index-file will be fetched. Three
|
|
|
114 methods are possible: 'local assumes that all files are local.
|
|
|
115 'local-index-only assumes that just the index-file is locally but
|
|
|
116 all other files will be fetched via www. 'www means that the index-file
|
|
|
117 will be fetched via WWW, too. Don't change the value of this variable
|
|
|
118 after loading.")
|
|
|
119
|
|
|
120 (defvar *cltl2-url*
|
|
|
121 "http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/"
|
|
|
122 "The url where the hypertext-version of Common Lisp the Language
|
|
|
123 can be found. Note that this assumes to be the top-level of the
|
|
|
124 directory structure which should be the same as in the hypertext
|
|
|
125 version as provided by the CMU AI Repository. Defaults to
|
|
|
126 http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/
|
|
|
127 Note the / at the end.")
|
|
|
128
|
|
|
129 (defvar *cltl2-local-file-pos* "/usr/doc/html/cltl/"
|
|
|
130 "A directory where the CLtl2 can be found. Note that this assumes
|
|
|
131 to be the top-level of the directory structure which should be the
|
|
|
132 same as in the hypertext version as provided by the CMU AI Repository.
|
|
|
133 Defaults to /usr/doc/html/cltl/ Note the / at the end.")
|
|
|
134
|
|
|
135 (defconst *cltl2-index-file-name* "clm/index.html"
|
|
|
136 "The name of the index-file, typically with directory on front.
|
|
|
137 Defaults to clm/index.html, as this is the momentary position from
|
|
|
138 the top-level directory of the CLtL2-home. Defaults to clm/index.html.
|
|
|
139 Note that there is no leading /.")
|
|
|
140
|
|
|
141 (defvar *cltl2-index-home*
|
|
|
142 (concatenate 'string
|
|
|
143 (case *cltl2-fetch-method*
|
|
|
144 ('local *cltl2-local-file-pos*)
|
|
|
145 ('local-index-only *cltl2-local-file-pos*)
|
|
|
146 ('www *cltl2-url*))
|
|
|
147 *cltl2-index-file-name*)
|
|
|
148 "The absolute path which will be used to fetch the index.")
|
|
|
149
|
|
|
150 (defvar *cltl2-home*
|
|
|
151 (concatenate
|
|
|
152 'string
|
|
|
153 (case *cltl2-fetch-method*
|
|
|
154 ('local *cltl2-local-file-pos*)
|
|
|
155 ('local-index-only *cltl2-url*)
|
|
|
156 ('www *cltl2-url*))
|
|
|
157 "clm/")
|
|
|
158 "This specifies the home-position of the CLtL2. The value of this variable
|
|
|
159 will be concatenated with the name of the nodes of the CLtL2.")
|
|
|
160
|
|
|
161 (defvar *cltl2-index-buffer-name* "*cltl2-index*"
|
|
|
162 "The name of the buffer which holds the index for CLtL2.")
|
|
|
163
|
|
|
164 (defvar *cltl2-old-find-file-noselect* 'nil
|
|
|
165 "Older versions of Emacs (at least XEmacs 19.11) don't support the
|
|
|
166 option RAWFILE with the function FIND-FILE-NO-SELECT. Set this variable
|
|
|
167 to 't if you have such an old version. It will cause fontification and
|
|
|
168 other useless stuff on the buffer in which the index is fetched. If
|
|
|
169 you don't use a local copy (of the index) this won't bother you.")
|
|
|
170
|
|
|
171 (defvar *browse-cltl2-ht* (make-hash-table 0))
|
|
|
172 (defconst *cltl2-search-regexpr*
|
|
|
173 "<a href=\"\\(.+\\)\"><code>\\(.+\\)</code></a>"
|
|
|
174 "A regular expression how to check for entries in the index-file
|
|
|
175 of CLtL2. Note that you have to modify this and the
|
|
|
176 prepare-get-entry*-functions if you want to change the search.")
|
|
|
177
|
|
|
178 ;;; ******************************
|
|
|
179 ;;; First of all: Compatibility stuff
|
|
|
180 ;;; ******************************
|
|
|
181 ; no match-string in old versions
|
|
|
182 (if (not (fboundp (function match-string)))
|
|
|
183 (defun match-string (num &optional string)
|
|
|
184 "Return string of text matched by last search.
|
|
|
185 NUM specifies which parenthesized expression in the last regexp.
|
|
|
186 Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
|
|
|
187 Zero means the entire text matched by the whole regexp or whole string.
|
|
|
188 STRING should be given if the last search was by `string-match' on STRING."
|
|
|
189 (if (match-beginning num)
|
|
|
190 (if string
|
|
|
191 (substring string (match-beginning num) (match-end num))
|
|
|
192 (buffer-substring
|
|
|
193 (match-beginning num) (match-end num))))))
|
|
|
194
|
|
|
195 ; no buffer-live-p in old versions
|
|
|
196 (if (not (fboundp (function buffer-live-p)))
|
|
|
197 (defun buffer-live-p (buf-or-name)
|
|
|
198 "Checks if BUF-OR-NAME is a live buffer. Returns non-nil
|
|
|
199 if BOF-OR-NAME is an editor buffer which has not been deleted.
|
|
|
200 Imitating a built-in function from newer Emacs versions."
|
|
|
201 (let ((object (if (bufferp buf-or-name)
|
|
|
202 buf-or-name
|
|
|
203 (get-buffer buf-or-name))))
|
|
|
204 (and (bufferp object) (buffer-name object)))))
|
|
|
205
|
|
|
206 ; no add-submenu in old versions of XEmacs
|
|
|
207 (if (and (string-match "XEmacs\\|Lucid" emacs-version)
|
|
|
208 (not (fboundp 'add-submenu)))
|
|
|
209 (defun add-submenu (menu-path submenu &optional before)
|
|
|
210 "Add a menu to the menubar or one of its submenus.
|
|
|
211 If the named menu exists already, it is changed.
|
|
|
212 MENU-PATH identifies the menu under which the new menu should be inserted.
|
|
|
213 It is a list of strings; for example, (\"File\") names the top-level \"File\"
|
|
|
214 menu. (\"File\" \"Foo\") names a hypothetical submenu of \"File\".
|
|
|
215 If MENU-PATH is nil, then the menu will be added to the menubar itself.
|
|
|
216 SUBMENU is the new menu to add.
|
|
|
217 See the documentation of `current-menubar' for the syntax.
|
|
|
218 BEFORE, if provided, is the name of a menu before which this menu should
|
|
|
219 be added, if this menu is not on its parent already. If the menu is already
|
|
|
220 present, it will not be moved."
|
|
|
221 (add-menu menu-path (car submenu) (cdr submenu) before)))
|
|
|
222
|
|
|
223 ; old find-file-noselect has no RAWFILE argument
|
|
|
224 (if *cltl2-old-find-file-noselect*
|
|
|
225 (unless (boundp 'cltl2-old-find-file-noselect-func)
|
|
|
226 (setf (symbol-value 'cltl2-old-find-file-noselect-func)
|
|
|
227 (symbol-function 'find-file-noselect))
|
|
|
228 (setf (symbol-function 'find-file-noselect)
|
|
|
229 #'(lambda (file &optional nowarn rawfile)
|
|
|
230 (funcall cltl2-old-find-file-noselect-func file nowarn)))))
|
|
|
231
|
|
|
232 ;;; ******************************
|
|
|
233 ;;; Functions for fetching the index file
|
|
|
234 ;;; ******************************
|
|
|
235 (defun cltl2-fetch-index ()
|
|
|
236 "Fetches the index page of the CLtl2 and puts it in its own
|
|
|
237 buffer called *cltl2-index*."
|
|
|
238 ;; if the index isn't here load it into a buffer
|
|
|
239 (when (or (not (get-buffer *cltl2-index-buffer-name*))
|
|
|
240 (not (buffer-live-p *cltl2-index-buffer-name*)))
|
|
|
241 (message "Fetching the CLtL2 index file ...")
|
|
|
242 (case *cltl2-fetch-method*
|
|
|
243 ('local
|
|
|
244 (cltl2-fetch-index-by-file))
|
|
|
245 ('local-index-only
|
|
|
246 (cltl2-fetch-index-by-file))
|
|
|
247 ('www
|
|
|
248 (cltl2-fetch-index-by-www))))
|
|
|
249
|
|
|
250 (cltl2-prepare-index)
|
|
|
251 )
|
|
|
252
|
|
|
253 ;; fetch methods
|
|
|
254 (defun cltl2-fetch-index-by-file ()
|
|
|
255 "Fetch the index from disk."
|
|
|
256 (setf *cltl2-index-buffer-name*
|
|
|
257 (find-file-noselect *cltl2-index-home* 'nil 't))
|
|
|
258 )
|
|
|
259
|
|
|
260 (defun cltl2-fetch-index-by-www ()
|
|
|
261 "Fetch the index via WWW."
|
|
|
262 (save-excursion
|
|
|
263 (let ((old-url-working-buffer url-working-buffer))
|
|
|
264 (setf url-working-buffer *cltl2-index-buffer-name*)
|
|
|
265 (url-retrieve *cltl2-index-home*)
|
|
|
266 (setf url-working-buffer old-url-working-buffer))))
|
|
|
267
|
|
|
268
|
|
|
269 ;;; ******************************
|
|
|
270 ;;; Main functions for viewing
|
|
|
271 ;;; ******************************
|
|
|
272 (defun cltl2-view-function-definition (entry)
|
|
|
273 "First checks if function can be found in the CLtL2-index-file.
|
|
|
274 If it can be found, uses the function browse-url to have a look
|
|
|
275 at the corresponding documentation from CLtL2."
|
|
|
276 (interactive "sCLtL2-Entry to lookup:")
|
|
|
277 (when (cltl2-index-unprepared-p)
|
|
|
278 (cltl2-fetch-index))
|
|
|
279
|
|
|
280 (let ((entry-url (cltl2-find-url-for-function (intern entry))))
|
|
|
281 (when entry-url
|
|
|
282 (message "Loading found entry for %s into browser.." entry)
|
|
|
283 (browse-url
|
|
|
284 (concatenate 'string *cltl2-home* entry-url)))))
|
|
|
285
|
|
|
286 (defun cltl2-find-url-for-function (entry)
|
|
|
287 "Checks if we can find a page for function ENTRY and
|
|
|
288 constructs an URL from it."
|
|
|
289 (let ((entry-url (gethash entry *browse-cltl2-ht*)))
|
|
|
290 (when (not entry-url)
|
|
|
291 (error "No entry in CLtL2 for %s" entry))
|
|
|
292 entry-url))
|
|
|
293
|
|
|
294 (defun cltl2-view-index ()
|
|
|
295 "Browse-urls the index file."
|
|
|
296 (interactive)
|
|
|
297 (browse-url *cltl2-index-home*))
|
|
|
298
|
|
|
299 ;;; ******************************
|
|
|
300 ;;; Preparing the index (the hashtable)
|
|
|
301 ;;; ******************************
|
|
|
302 (defun cltl2-prepare-index ()
|
|
|
303 "Jumps to the *cltl2-index* buffer and scans it, creating a hashtable
|
|
|
304 for all entries."
|
|
|
305 (message "Preparing CLtL2 index.")
|
|
|
306 (save-excursion
|
|
|
307 (set-buffer *cltl2-index-buffer-name*)
|
|
|
308 (goto-char (point-min))
|
|
|
309
|
|
|
310 ; search for entry
|
|
|
311 (do ((point (re-search-forward
|
|
|
312 *cltl2-search-regexpr*
|
|
|
313 nil t)
|
|
|
314 (re-search-forward
|
|
|
315 *cltl2-search-regexpr*
|
|
|
316 nil t)))
|
|
|
317 ; until we can't find anymore
|
|
|
318 ((null point)); (format "Index-preparation done."))
|
|
|
319 ; put found entry in hash-table
|
|
|
320 (cl-puthash
|
|
|
321 (cltl2-prepare-get-entry-name)
|
|
|
322 (cltl2-prepare-get-entry-url)
|
|
|
323 *browse-cltl2-ht*))))
|
|
|
324
|
|
|
325 (defun cltl2-prepare-get-entry-name ()
|
|
|
326 "Get the enrty name from the last match of regexp-search for entries."
|
|
|
327 (let ((name-string (intern (match-string 2))))
|
|
|
328 (format "%s" name-string)
|
|
|
329 name-string))
|
|
|
330
|
|
|
331 (defun cltl2-prepare-get-entry-url ()
|
|
|
332 "Get the enrty url from the last match of regexp-search for entries."
|
|
|
333 (let ((url (match-string 1)))
|
|
|
334 (format "%s" url)
|
|
|
335 url))
|
|
|
336
|
|
|
337 (defun cltl2-index-unprepared-p ()
|
|
|
338 "Check if the index is already prepared."
|
|
|
339 ; If the hashtable has entries the index is prepared.
|
|
|
340 (not (and (hash-table-p *browse-cltl2-ht*)
|
|
|
341 (>= (hash-table-count *browse-cltl2-ht*) 1))))
|
|
|
342
|
|
|
343 ;;; ******************************
|
|
|
344 ;;; Hooking into lisp mode and ilisp-mode
|
|
|
345 ;;; ******************************
|
|
|
346 (defun cltl2-lisp-mode-install ()
|
|
|
347 "Not to be called by the user - just for lisp-mode-hook and ilisp-mode-hook.
|
|
|
348
|
|
|
349 Adds browse-cltl2 to lisp-mode. If you use ilisp (installed via a hook
|
|
|
350 on lisp-mode) add browse-cltl2 to ilisp. Under Ilisp we use C-zb and C-zB
|
|
|
351 and without Ilisp we use C-cb and C-cB for calling the cltl2-view-functions.
|
|
|
352 Under XEmacs we will add ourself to the corresponding menus if there exists
|
|
|
353 one.."
|
|
|
354 ; set key bindings
|
|
|
355 (cond ((featurep 'ilisp)
|
|
|
356 (local-set-key "\C-zb" 'cltl2-view-function-definition)
|
|
|
357 (local-set-key "\C-zB" 'cltl2-view-index))
|
|
|
358 (t
|
|
|
359 (local-set-key "\C-cb" 'cltl2-view-function-definition)
|
|
|
360 (local-set-key "\C-cB" 'cltl2-view-index)))
|
|
|
361 ; under XEmacs hook ourself into the menu if there is one
|
|
|
362 (when (string-match "XEmacs\\|Lucid" emacs-version)
|
|
|
363 ; this is for the menu as provided by ilisp-easy-menu
|
|
|
364 (cond ((not (null (car (find-menu-item current-menubar '("ILisp")))))
|
|
|
365 (add-submenu
|
|
|
366 '("ILisp" "Documentation")
|
|
|
367 '("Browse CLtL2"
|
|
|
368 [ "View entry" cltl2-view-function-definition t]
|
|
|
369 [ "View index" cltl2-view-index t] )))
|
|
|
370 ((not (null (car (find-menu-item current-menubar '("Lisp")))))
|
|
|
371 (add-submenu
|
|
|
372 '("Lisp")
|
|
|
373 '("Browse CLtL2"
|
|
|
374 [ "View entry" cltl2-view-function-definition t]
|
|
|
375 [ "View index" cltl2-view-index t] )))))
|
|
|
376 )
|
|
|
377
|
|
|
378 (add-hook 'lisp-mode-hook 'cltl2-lisp-mode-install)
|
|
|
379 (add-hook 'ilisp-mode-hook 'cltl2-lisp-mode-install)
|
|
|
380
|
|
|
381 ;;; Providing ourself.
|
|
|
382 (provide 'ilisp-browse-cltl2)
|
|
|
383 ;;; browse-cltl2.el ends here.
|
