Source

net-utils / browse-cltl2.el

Diff from to

browse-cltl2.el

 ;;          two arguments in Emacs 19.29.
 
 
-(defvar *cltl2-use-url* 'nil
- "Enables or disables retrieval of the index-file via WWW (or more
- exactly by the use of the function url-retrieve from url.el).
- Default is 't.")
+(defvar *cltl2-use-url* t
+ "Enables or disables retrieval of the index-file via WWW.
+Default is t.")
 
 ;; needed things
 (require 'cl)
 (require 'browse-url)
-(autoload 'url-retrieve "url")
-
-(when (not *cltl2-use-url*)
-   (require 'url))
 
 ;;; ******************************
 ;;; Some variable and constant definitions
 ;;; ******************************
-(defvar *cltl2-fetch-method* 'local
- "This sets the method by which the index-file will be fetched. Three
-  methods are possible: 'local assumes that all files are local. 
-  'local-index-only assumes that just the index-file is locally but
-  all other files will be fetched via www. 'www means that the index-file
-  will be fetched via WWW, too. Don't change the value of this variable
-  after loading.")
+(defvar *cltl2-fetch-method* 'www
+ "This sets the method by which the index-file will be fetched.
+
+Three methods are possible: 'local assumes that all files are
+local. 'local-index-only assumes that just the index-file is
+locally but all other files will be fetched via www. 'www means
+that the index-file will be fetched via WWW, too. Don't change
+the value of this variable after loading.")
 
 (defvar *cltl2-url* 
  "http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/"
- "The url where the hypertext-version of Common Lisp the Language
- can be found. Note that this assumes to be the top-level of the
- directory structure which should be the same as in the hypertext
- version as provided by the CMU AI Repository. Defaults to
- http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/
- Note the / at the end.")
+ "The url where the HTML of Common Lisp the Language can be found.
+
+Note that this assumes to be the top-level of the directory structure
+which should be the same as in the hypertext version as provided by
+the CMU AI Repository. Defaults to
+http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/
+Note the / at the end.")
 
 (defvar *cltl2-local-file-pos* "/usr/doc/html/cltl/"
- "A directory where the CLtl2 can be found. Note that this assumes
- to be the top-level of the directory structure which should be the
- same as in the hypertext version as provided by the CMU AI Repository.
- Defaults to /usr/doc/html/cltl/ Note the / at the end.")
+ "A directory where the CLtl2 can be found. 
+
+Note that this assumes to be the top-level of the directory structure
+which should be the same as in the hypertext version as provided by
+the CMU AI Repository.  Defaults to /usr/doc/html/cltl/ Note the / at
+the end.")
 
 (defconst *cltl2-index-file-name* "clm/index.html"
  "The name of the index-file, typically with directory on front. 
-  Defaults to clm/index.html, as this is the momentary position from
-  the top-level directory of the CLtL2-home. Defaults to clm/index.html.
-  Note that there is no leading /.")
+
+Defaults to clm/index.html, as this is the momentary position from the
+top-level directory of the CLtL2-home. Defaults to clm/index.html.
+Note that there is no leading /.")
 
 (defvar *cltl2-index-home* 
   (concatenate 'string
      ('local-index-only *cltl2-url*)
      ('www *cltl2-url*))
      "clm/")
-  "This specifies the home-position of the CLtL2. The value of this variable
-  will be concatenated with the name of the nodes of the CLtL2.")
+  "This specifies the home-position of the CLtL2.
+
+The value of this variable will be concatenated with the name of the
+nodes of the CLtL2.")
 
 (defvar *cltl2-index-buffer-name* "*cltl2-index*"
  "The name of the buffer which holds the index for CLtL2.")
 
-(defvar *cltl2-old-find-file-noselect* 'nil
- "Older versions of Emacs (at least XEmacs 19.11) don't support the
- option RAWFILE with the function FIND-FILE-NO-SELECT. Set this variable
- to 't if you have such an old version. It will cause fontification and
- other useless stuff on the buffer in which the index is fetched. If
- you don't use a local copy (of the index) this won't bother you.")
-
 (defvar *cltl2-vfd-key* 
   (if (featurep 'ilisp)
       '[(control z) h]
      '[(control c) b])
- "Shortcut for accessing cltl2-view-function-definition. Use meaningful
- setting with Ilisp.")
+ "Shortcut for accessing cltl2-view-function-definition.
+Use meaningful setting with Ilisp.")
 
 (defvar *cltl2-vi-key* 
   (if (featurep 'ilisp)
       '[(control z) H]
      '[(control c) B])
- "Shortcut for accessing cltl2-view-index. Use meaningful
- setting with Ilisp.")
+ "Shortcut for accessing cltl2-view-index.
+Use meaningful setting with Ilisp.")
 
-(defvar *browse-cltl2-ht* (make-hash-table 0))
+(defvar *browse-cltl2-ht* (make-hash-table :size 25))
+
 (defconst *cltl2-search-regexpr* 
   "<a href=\"\\(.+\\)\"><code>\\(.+\\)</code></a>"
-  "A regular expression how to check for entries in the index-file
-  of CLtL2. Note that you have to modify this and the 
-  prepare-get-entry*-functions if you want to change the search.")
+  "A regexp how to check for entries in the index-file of CLtL2.
+
+Note that you have to modify this and the prepare-get-entry*-functions
+if you want to change the search.")
 
 (defvar *browse-cltl2-history* nil
   "History of CLtL2-entries to lookup.")
 
 ;;; ******************************
-;;; First of all: Compatibility stuff
-;;; ******************************
-; no match-string in old versions
-(if (not (fboundp (function match-string)))
-    (defun match-string (num &optional string)
-      "Return string of text matched by last search.
- NUM specifies which parenthesized expression in the last regexp.
- Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
- Zero means the entire text matched by the whole regexp or whole string.
- STRING should be given if the last search was by `string-match' on STRING."
-      (if (match-beginning num)
-	  (if string
-	      (substring string (match-beginning num) (match-end num))
-	      (buffer-substring 
-	       (match-beginning num) (match-end num))))))
-
-; no buffer-live-p in old versions
- (if (not (fboundp (function buffer-live-p)))
-     (defun buffer-live-p (buf-or-name)
-       "Checks if BUF-OR-NAME is a live buffer. Returns non-nil
- if BOF-OR-NAME is an editor buffer which has not been deleted.
- Imitating a built-in function from newer Emacs versions."
-       (let ((object (if (bufferp buf-or-name) 
-                          buf-or-name
-			(get-buffer buf-or-name))))
-	 (and (bufferp object) (buffer-name object)))))
-
-; no add-submenu in old versions of XEmacs       
-(if (and (string-match "XEmacs\\|Lucid" emacs-version)
-	 (not (fboundp 'add-submenu)))
-    (defun add-submenu (menu-path submenu &optional before)
-  "Add a menu to the menubar or one of its submenus.
-If the named menu exists already, it is changed.
-MENU-PATH identifies the menu under which the new menu should be inserted.
- It is a list of strings; for example, (\"File\") names the top-level \"File\"
- menu.  (\"File\" \"Foo\") names a hypothetical submenu of \"File\".
- If MENU-PATH is nil, then the menu will be added to the menubar itself.
-SUBMENU is the new menu to add.
- See the documentation of `current-menubar' for the syntax.
-BEFORE, if provided, is the name of a menu before which this menu should
- be added, if this menu is not on its parent already.  If the menu is already
- present, it will not be moved."
-  (add-menu menu-path (car submenu) (cdr submenu) before)))
-
-; stolen from XEmacs 19.15 syntax.el
-(if (not (fboundp (function symbol-near-point)))
-    (defun symbol-near-point ()
-      "Return the first textual item to the nearest point."
-      (interactive)
-	;alg stolen from etag.el
-      (save-excursion
-	(if (not (memq (char-syntax (preceding-char)) '(?w ?_)))
-	    (while (not (looking-at "\\sw\\|\\s_\\|\\'"))
-	      (forward-char 1)))
-	(while (looking-at "\\sw\\|\\s_")
-	  (forward-char 1))
-	(if (re-search-backward "\\sw\\|\\s_" nil t)
-	    (regexp-quote
-	     (progn (forward-char 1)
-		    (buffer-substring (point)
-				      (progn (forward-sexp -1)
-					     (while (looking-at "\\s'")
-					       (forward-char 1))
-					     (point)))))
-	  nil))))
-
-; needed for 19.11, I think
-(if (not (fboundp (function url-lazy-message)))
-  (defun url-lazy-message (&rest args)
-    "Just like `message', but is a no-op if called more than once a second.
-Will not do anything if url-show-status is nil."
-    (if (or (null url-show-status)
-	    (= url-lazy-message-time
-	       (setq url-lazy-message-time (nth 1 (current-time)))))
-	nil
-      (apply 'message args))))
-
-; old find-file-noselect has no RAWFILE argument
-(if *cltl2-old-find-file-noselect*
-    (unless (boundp 'cltl2-old-find-file-noselect-func)
-      (setf (symbol-value 'cltl2-old-find-file-noselect-func)
-	    (symbol-function 'find-file-noselect))
-      (setf (symbol-function 'find-file-noselect)
-	    (function 
-	     (lambda (file &optional nowarn rawfile)
-	       (funcall cltl2-old-find-file-noselect-func file nowarn))))))
-  
-;;; ******************************
 ;;; Functions for fetching the index file
 ;;; ******************************
 (defun cltl2-fetch-index ()
   "Fetches the index page of the CLtl2 and puts it in its own
  buffer called *cltl2-index*."
   ;; if the index isn't here load it into a buffer
-  (when (or (not (get-buffer *cltl2-index-buffer-name*))
-	    (not (buffer-live-p *cltl2-index-buffer-name*)))
+  (unless (get-buffer *cltl2-index-buffer-name*)
     (message "Fetching the CLtL2 index file ...")
-    (case *cltl2-fetch-method* 
-      ('local 
-       (cltl2-fetch-index-by-file))
-      ('local-index-only
-       (cltl2-fetch-index-by-file))
-      ('www
-       (cltl2-fetch-index-by-www))))
+    (if (eq *cltl2-fetch-method* 'www)
+	(cltl2-fetch-index-by-www)
+      (cltl2-fetch-index-by-file)))
   
   (cltl2-prepare-index)
 )
 ;; fetch methods
 (defun cltl2-fetch-index-by-file ()
   "Fetch the index from disk."
-  (if (not (file-readable-p *cltl2-index-home*))
-      (error "CLtL2 index file not readable: %s." *cltl2-index-home*))
+  (unless (file-readable-p *cltl2-index-home*)
+    (error "CLtL2 index file not readable: %s" *cltl2-index-home*))
 
   (setf *cltl2-index-buffer-name*
-	(find-file-noselect *cltl2-index-home* 'nil 't)))
+	(find-file-noselect *cltl2-index-home* nil t)))
+
+(eval-when-compile
+  (defvar url-working-buffer))
+
+(autoload 'url-retrieve "url")
 
 (defun cltl2-fetch-index-by-www ()
  "Fetch the index via WWW."
  (save-excursion
-   (let ((old-url-working-buffer url-working-buffer))
-     (setf url-working-buffer *cltl2-index-buffer-name*)
-     (url-retrieve *cltl2-index-home*)
-     (setf url-working-buffer old-url-working-buffer))))
-
+   (let ((url-working-buffer *cltl2-index-buffer-name*))
+     (url-retrieve *cltl2-index-home*))))
 
 ;;; ******************************
 ;;; Main functions for viewing