1;;; clhs.el -- access the Common Lisp HyperSpec (CLHS) 2 3;;; this works with both 4;;; * the "long file name" version released by Harlequin and available 5;;; at the MIT web site as 6;;; <http://www.ai.mit.edu/projects/iiip/doc/CommonLISP/HyperSpec/FrontMatter/> and 7;;; * the "8.3 file name" version released later by Xanalys and available at 8;;; <http://www.xanalys.com/software_tools/reference/HyperSpec/> 9;;; and downloadable as 10;;; <http://www.xanalys.com/software_tools/reference/HyperSpec/HyperSpec-6-0.tar.gz> 11;;; This is accomplished by not hard-wiring the symbol->file table 12;;; but reading the Data/<map> file instead 13 14;;; Copyright (C) 2002-2008, 2017 Sam Steingold <sds@gnu.org> 15;;; Keywords: lisp, common lisp, emacs, ANSI CL, hyperspec 16;;; released under the GNU GPL <http://www.gnu.org/copyleft/gpl.html> 17;;; as a part of GNU CLISP <http://clisp.cons.org>, <http://www.clisp.org> 18 19;;; Commentary: 20 21;; Kent Pitman and the Harlequin Group (later Xanalys) have made the 22;; text of the "American National Standard for Information Technology -- 23;; Programming Language -- Common Lisp", ANSI X3.226-1994 available on 24;; the WWW, in the form of the Common Lisp HyperSpec. This package 25;; makes it convenient to peruse this documentation from within Emacs. 26 27;; This is inspired by the Erik Naggum's version of 1997. 28 29;;; Code: 30 31(eval-when-compile (require 'cl)) ; push 32(require 'browse-url) 33(require 'thingatpt) 34(require 'url) 35 36(defcustom common-lisp-hyperspec-root "http://clhs.lisp.se/" 37 ;; "http://www.lispworks.com/documentation/HyperSpec/" 38 ;; "http://www.cs.cmu.edu/afs/cs/project/ai-repository/ai/html/hyperspec/HyperSpec/" 39 ;; "http://www.ai.mit.edu/projects/iiip/doc/CommonLISP/HyperSpec/" 40 "*The root of the Common Lisp HyperSpec URL. 41If you copy the HyperSpec to your local system, set this variable to 42something like \"file:/usr/local/doc/HyperSpec/\"." 43 :group 'lisp 44 :type 'string) 45 46(defvar clhs-history nil 47 "History of symbols looked up in the Common Lisp HyperSpec so far.") 48 49(defvar clhs-symbols nil) 50 51(defun clhs-table-buffer (&optional root) 52 (unless root (setq root common-lisp-hyperspec-root)) 53 (if (string-match "^file:/" root) 54 (with-current-buffer (get-buffer-create " *clhs-tmp-buf*") 55 (insert-file-contents-literally 56 (let* ((d (concat (substring root 6) "/Data/")) 57 (f (concat d "Map_Sym.txt"))) 58 (if (file-exists-p f) f 59 (setq f (concat d "Symbol-Table.text")) 60 (if (file-exists-p f) f 61 (error "no symbol table at %s" root)))) 62 nil nil nil t) 63 (goto-char 0) 64 (current-buffer)) 65 (let* ((d (concat root "/Data/")) 66 (f (concat d "Map_Sym.txt"))) 67 (set-buffer (url-retrieve-synchronously f)) 68 (goto-char 0) 69 (unless (looking-at "^HTTP/.*200 *OK$") 70 (kill-buffer (current-buffer)) 71 (setq f (concat d "Symbol-Table.text")) 72 (set-buffer (url-retrieve-synchronously f)) 73 (goto-char 0) 74 (unless (looking-at "^HTTP/.*200 *OK$") 75 (kill-buffer (current-buffer)) 76 (error "no symbol table at %s" root))) 77 ;; skip to the first symbol 78 (search-forward "\n\n") 79 (current-buffer)))) 80 81(defun clhs-read-symbols () 82 "read `clhs-symbols' from the current position in the current buffer" 83 (while (not (eobp)) 84 (puthash (buffer-substring-no-properties ; symbol 85 (line-beginning-position) (line-end-position)) 86 (progn (forward-line 1) ; file name 87 (buffer-substring-no-properties ; strip "../" 88 (+ 3 (line-beginning-position)) (line-end-position))) 89 clhs-symbols) 90 (forward-line 1))) 91 92(defun clhs-symbols () 93 "Get `clhs-symbols' from `common-lisp-hyperspec-root'." 94 (if (and clhs-symbols (not (= 0 (hash-table-count clhs-symbols)))) 95 clhs-symbols 96 (with-current-buffer (clhs-table-buffer) 97 (unless clhs-symbols 98 (setq clhs-symbols (make-hash-table :test 'equal :size 1031))) 99 (clhs-read-symbols) 100 (kill-buffer (current-buffer)) 101 clhs-symbols))) 102 103(defun hash-table-complete (string table how) 104 "This makes it possible to use hash-tables with `completing-read'. 105Actually, `completing-read' in Emacs 22 accepts hash-tables natively." 106 (let ((res nil) (st (upcase string)) (len (length string))) 107 (maphash (lambda (key val) 108 (when (and (<= len (length key)) 109 (string= st (substring key 0 len))) 110 (push key res))) 111 table) 112 (if how 113 res ; `all-completions' 114 (if (cdr res) 115 (try-completion st (mapcar #'list res)) 116 (if (string= st (car res)) 117 t 118 (car res)))))) 119 120;;;###autoload 121(defun common-lisp-hyperspec (symbol-name &optional kill) 122 "Browse the Common Lisp HyperSpec documentation for SYMBOL-NAME. 123Finds the HyperSpec at `common-lisp-hyperspec-root'. 124With prefix arg, save the URL in the `kill-ring' instead." 125 (interactive (list (let ((sym (thing-at-point 'symbol t)) 126 (completion-ignore-case t)) 127 (completing-read 128 "Look-up symbol in the Common Lisp HyperSpec: " 129 #'hash-table-complete (clhs-symbols) 130 t sym 'clhs-history)) 131 current-prefix-arg)) 132 (unless (= ?/ (aref common-lisp-hyperspec-root 133 (1- (length common-lisp-hyperspec-root)))) 134 (setq common-lisp-hyperspec-root 135 (concat common-lisp-hyperspec-root "/"))) 136 (let ((url (concat common-lisp-hyperspec-root 137 (gethash (upcase symbol-name) (clhs-symbols))))) 138 (if kill 139 (kill-new url) 140 (browse-url url)))) 141 142(provide 'clhs) 143