cgit.sxemacs.org Git - packages/blob - xemacs-packages/net-utils/browse-cltl2.el

   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.4
   6 ;; last edited on 19.5.1998
   7
   8 ;; Copyright (C) 1997, 1998 Holger Schauer
   9
  10 ;; Author: Holger Schauer <Holger.Schauer@gmx.de>
  11 ;; Keywords: utils lisp ilisp www
  12
  13 ;; This file is part of XEmacs.
  14
  15 ;; Developed under XEmacs 19.14. Also tested on Emacs 19.29, 19.32
  16 ;; and XEmacs 19.11, 19.16, 20.3. 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 (Emacs 19.29 and 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 ;;
  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.
 103 ;;
 104 ;; 28-02-98 HS: use symbol-near-point to obtain a default value to
 105 ;;         search for and added a history for already searched entries.
 106 ;;
 107 ;; 22-04-98 HS: added an error message if index-file does not exist.
 108 ;;
 109 ;; 27-04-98 HS: fixed a bug with the minibuffer history. Thanks to
 110 ;;          Sam Mikes <smikes@alumni.hmc.edu> for pointing out the
 111 ;;          existence of `minibuffer-history-minimum-string-length'
 112 ;;
 113 ;; 19-05-98 HS: changed #' to (function ... in order to make it work
 114 ;;          with older emacsen. `minibuffer-history-minimum-string-length'
 115 ;;          is also unknown to older emacsen. `read-string' had only
 116 ;;          two arguments in Emacs 19.29.
 117
 118
 119 (defvar *cltl2-use-url* t
 120  "Enables or disables retrieval of the index-file via WWW.
 121 Default is t.")
 122
 123 ;; needed things
 124 (require 'cl)
 125 (require 'browse-url)
 126
 127 ;;; ******************************
 128 ;;; Some variable and constant definitions
 129 ;;; ******************************
 130 (defvar *cltl2-fetch-method* 'www
 131  "This sets the method by which the index-file will be fetched.
 132
 133 Three methods are possible: 'local assumes that all files are
 134 local. 'local-index-only assumes that just the index-file is
 135 locally but all other files will be fetched via www. 'www means
 136 that the index-file will be fetched via WWW, too. Don't change
 137 the value of this variable after loading.")
 138
 139 (defvar *cltl2-url*
 140  "http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/"
 141  "The url where the HTML of Common Lisp the Language can be found.
 142
 143 Note that this assumes to be the top-level of the directory structure
 144 which should be the same as in the hypertext version as provided by
 145 the CMU AI Repository. Defaults to
 146 http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/
 147 Note the / at the end.")
 148
 149 (defvar *cltl2-local-file-pos* "/usr/doc/html/cltl/"
 150  "A directory where the CLtl2 can be found.
 151
 152 Note that this assumes to be the top-level of the directory structure
 153 which should be the same as in the hypertext version as provided by
 154 the CMU AI Repository.  Defaults to /usr/doc/html/cltl/ Note the / at
 155 the end.")
 156
 157 (defconst *cltl2-index-file-name* "clm/index.html"
 158  "The name of the index-file, typically with directory on front.
 159
 160 Defaults to clm/index.html, as this is the momentary position from the
 161 top-level directory of the CLtL2-home. Defaults to clm/index.html.
 162 Note that there is no leading /.")
 163
 164 (defvar *cltl2-index-home*
 165   (concatenate 'string
 166      (case *cltl2-fetch-method*
 167        ('local *cltl2-local-file-pos*)
 168        ('local-index-only *cltl2-local-file-pos*)
 169        ('www *cltl2-url*))
 170      *cltl2-index-file-name*)
 171  "The absolute path which will be used to fetch the index.")
 172
 173 (defvar *cltl2-home*
 174   (concatenate
 175    'string
 176    (case *cltl2-fetch-method*
 177      ('local *cltl2-local-file-pos*)
 178      ('local-index-only *cltl2-url*)
 179      ('www *cltl2-url*))
 180      "clm/")
 181   "This specifies the home-position of the CLtL2.
 182
 183 The value of this variable will be concatenated with the name of the
 184 nodes of the CLtL2.")
 185
 186 (defvar *cltl2-index-buffer-name* "*cltl2-index*"
 187  "The name of the buffer which holds the index for CLtL2.")
 188
 189 (defvar *cltl2-vfd-key*
 190   (if (featurep 'ilisp)
 191       '[(control z) h]
 192      '[(control c) b])
 193  "Shortcut for accessing cltl2-view-function-definition.
 194 Use meaningful setting with Ilisp.")
 195
 196 (defvar *cltl2-vi-key*
 197   (if (featurep 'ilisp)
 198       '[(control z) H]
 199      '[(control c) B])
 200  "Shortcut for accessing cltl2-view-index.
 201 Use meaningful setting with Ilisp.")
 202
 203 (defvar *browse-cltl2-ht* (make-hash-table :size 25))
 204
 205 (defconst *cltl2-search-regexpr*
 206   "<a href=\"\\(.+\\)\"><code>\\(.+\\)</code></a>"
 207   "A regexp how to check for entries in the index-file of CLtL2.
 208
 209 Note that you have to modify this and the prepare-get-entry*-functions
 210 if you want to change the search.")
 211
 212 (defvar *browse-cltl2-history* nil
 213   "History of CLtL2-entries to lookup.")
 214
 215 ;;; ******************************
 216 ;;; Functions for fetching the index file
 217 ;;; ******************************
 218 (defun cltl2-fetch-index ()
 219   "Fetches the index page of the CLtl2 and puts it in its own
 220  buffer called *cltl2-index*."
 221   ;; if the index isn't here load it into a buffer
 222   (unless (get-buffer *cltl2-index-buffer-name*)
 223     (message "Fetching the CLtL2 index file ...")
 224     (if (eq *cltl2-fetch-method* 'www)
 225         (cltl2-fetch-index-by-www)
 226       (cltl2-fetch-index-by-file)))
 227
 228   (cltl2-prepare-index)
 229 )
 230
 231 ;; fetch methods
 232 (defun cltl2-fetch-index-by-file ()
 233   "Fetch the index from disk."
 234   (unless (file-readable-p *cltl2-index-home*)
 235     (error "CLtL2 index file not readable: %s" *cltl2-index-home*))
 236
 237   (setf *cltl2-index-buffer-name*
 238         (find-file-noselect *cltl2-index-home* nil t)))
 239
 240 (eval-when-compile
 241   (defvar url-working-buffer))
 242
 243 (autoload 'url-retrieve "url")
 244
 245 (defun cltl2-fetch-index-by-www ()
 246  "Fetch the index via WWW."
 247  (save-excursion
 248    (let ((url-working-buffer *cltl2-index-buffer-name*))
 249      (url-retrieve *cltl2-index-home*))))
 250
 251 ;;; ******************************
 252 ;;; Main functions for viewing
 253 ;;; ******************************
 254 (defun cltl2-view-function-definition (entry)
 255   "First checks if function can be found in the CLtL2-index-file.
 256  If it can be found, uses the function browse-url to have a look
 257  at the corresponding documentation from CLtL2."
 258   (interactive
 259    (let ((ol-hist-val (if (boundp 'minibuffer-history-minimum-string-length)
 260                           minibuffer-history-minimum-string-length
 261                         nil))
 262          (entry-val nil))
 263      (setq minibuffer-history-minimum-string-length nil)
 264      (setq entry-val
 265            (list (read-from-minibuffer
 266                   (concatenate 'string
 267                                "CLtL2-Entry to lookup (default "
 268                                (symbol-near-point) "):")
 269                   nil nil nil
 270                   '*browse-cltl2-history*)))
 271      (setq minibuffer-history-minimum-string-length ol-hist-val)
 272      entry-val))
 273
 274   (cond ((equal "" entry)
 275          (setf entry (symbol-near-point))
 276          (setf *browse-cltl2-history*
 277                (push entry *browse-cltl2-history*))))
 278
 279   (when (cltl2-index-unprepared-p)
 280     (cltl2-fetch-index))
 281
 282   (let ((entry-url (cltl2-find-url-for-function (intern entry))))
 283     (when entry-url
 284      (message "Loading found entry for %s into browser.." entry)
 285      (browse-url
 286       (concatenate 'string *cltl2-home* entry-url)))))
 287
 288 (defun cltl2-find-url-for-function (entry)
 289   "Checks if we can find a page for function ENTRY and
 290  constructs an URL from it."
 291   (let ((entry-url (gethash entry *browse-cltl2-ht*)))
 292     (when (not entry-url)
 293       (error "No entry in CLtL2 for %s" entry))
 294     entry-url))
 295
 296 (defun cltl2-view-index ()
 297   "Browse-urls the index file."
 298   (interactive)
 299   (browse-url *cltl2-index-home*))
 300
 301 ;;; ******************************
 302 ;;; Preparing the index (the hashtable)
 303 ;;; ******************************
 304 (defun cltl2-prepare-index ()
 305  "Jumps to the *cltl2-index* buffer and scans it, creating a hashtable
 306  for all entries."
 307  (message "Preparing CLtL2 index.")
 308  (save-excursion
 309    (set-buffer *cltl2-index-buffer-name*)
 310    (goto-char (point-min))
 311
 312    ; search for entry
 313    (do ((point (re-search-forward
 314                  *cltl2-search-regexpr*
 315                  nil t)
 316                (re-search-forward
 317                 *cltl2-search-regexpr*
 318                 nil t)))
 319        ; until we can't find anymore
 320        ((null point)); (format "Index-preparation done."))
 321      ; put found entry in hash-table
 322      (puthash
 323       (cltl2-prepare-get-entry-name)
 324       (cltl2-prepare-get-entry-url)
 325       *browse-cltl2-ht*))))
 326
 327 (defun cltl2-prepare-get-entry-name ()
 328  "Get the enrty name from the last match of regexp-search for entries."
 329  (let ((name-string (intern (match-string 2))))
 330    (format "%s" name-string)
 331  name-string))
 332
 333 (defun cltl2-prepare-get-entry-url ()
 334  "Get the enrty url from the last match of regexp-search for entries."
 335  (let ((url (match-string 1)))
 336    (format "%s" url)
 337    url))
 338
 339 (defun cltl2-index-unprepared-p ()
 340  "Check if the index is already prepared."
 341  ; If the hashtable has entries the index is prepared.
 342  (not (and (hash-table-p *browse-cltl2-ht*)
 343            (>= (hash-table-count *browse-cltl2-ht*) 1))))
 344
 345 ;;; ******************************
 346 ;;; Hooking into lisp mode and ilisp-mode
 347 ;;; ******************************
 348 (defun cltl2-lisp-mode-install ()
 349  "Adds browse-cltl2 to lisp-mode. If you use ilisp (installed via a hook
 350  on lisp-mode) add browse-cltl2 to ilisp. Check the variables *cltl2-vfd-key*
 351  and *cltl2-vi-key* for the keybindings. Under XEmacs we will add ourself to
 352  the corresponding menus if there exists one."
 353  (interactive)
 354  ; set key bindings
 355  (local-set-key *cltl2-vfd-key* 'cltl2-view-function-definition)
 356  (local-set-key *cltl2-vi-key* 'cltl2-view-index)
 357  ; under XEmacs hook ourself into the menu if there is one
 358  (when (string-match "XEmacs\\|Lucid" emacs-version)
 359    (cond ((and (featurep 'ilisp-easy-menu)
 360                ; this is for the menu as provided by ilisp-easy-menu
 361                (not (null (car (find-menu-item current-menubar '("ILisp"))))))
 362           (add-submenu
 363            '("ILisp" "Documentation")
 364            '("Browse CLtL2"
 365              [ "View entry" cltl2-view-function-definition t]
 366              [ "View index" cltl2-view-index t] )))
 367            ; perhaps an other Ilisp-Menu is there ?
 368          ((not (null (car (find-menu-item current-menubar '("ILisp")))))
 369           (add-submenu
 370            '("Lisp")
 371            '("Browse CLtL2"
 372              [ "View entry" cltl2-view-function-definition t]
 373              [ "View index" cltl2-view-index t] )))
 374            ; or at least a Lisp-Menu ?
 375          ((not (null (car (find-menu-item current-menubar '("Lisp")))))
 376           (add-submenu
 377            '("Lisp")
 378            '("Browse CLtL2"
 379              [ "View entry" cltl2-view-function-definition t]
 380              [ "View index" cltl2-view-index t] )))))
 381 )
 382
 383 (add-hook 'lisp-mode-hook 'cltl2-lisp-mode-install)
 384 (add-hook 'ilisp-mode-hook 'cltl2-lisp-mode-install)
 385
 386 ;;; Providing ourself.
 387 (provide 'ilisp-browse-cltl2)
 388 ;;; browse-cltl2.el ends here.