Helm から Hyerspec/CLtL2 を引く

** 2014/05/11 slime をバージョンアップ したらHyperSpec が引けなくなったので修正

HyperSpec と CLtL2 を Helm から引けるようにします。 anything とまったく一緒です。

HyperSpec は ANSI Common Lispのリファレンス、CLtL2 は Common Lisp the Language, 2nd Editionの略記で仕様書風の読み物。CLTL1 → ANSI と仕様がFIXするまでの経緯等にもついて記載されているらしいです。私はほぼ HyperSpec しか使っていません。

設定方法は以下

まずそれぞれの入手先です。

■HyperSpec リンク先の There is a downloadable archive of the HyperSpec here から入手。
■CLTL2 リンク先の HTML version から入手
■hyperspec.el は SLIMEに付属
■cltl2.el

そのほか、Helm と emacs-w3m を事前に動くように設定しておく必要がありますが、ここでの説明は省略します。
後は、以下の elisp を .emacs や init,el 等へ記載すると動きます。

;; --------------------------------
;; HyperSpec を emacs-w3m で参照する
;; --------------------------------
(require 'hyperspec)

;; HyperSpecのパスを指定
(setq
 common-lisp-hyperspec-root
 "file:///home/.emacs.d/cl-docs/HyperSpec/"

 common-lisp-hyperspec-symbol-table
 (expand-file-name "~/.emacs.d/cl-docs/HyperSpec/Data/Map_Sym.txt"))

(defadvice common-lisp-hyperspec
  (around hyperspec-lookup-w3m () activate)
  (let* ((window-configuration (current-window-configuration))
         (browse-url-browser-function
          `(lambda (url new-window)
             (w3m-browse-url url nil)
             (let ((hs-map (copy-keymap w3m-mode-map)))
               (define-key hs-map (kbd "q")
                 (lambda ()
                   (interactive)
                   (kill-buffer nil)
                   (set-window-configuration ,window-configuration)))
               (use-local-map hs-map)))))
    ad-do-it))


;; --------------------------------
;; CLTL2 を emacs-w3m で参照する
;; --------------------------------
(require 'cltl2)

;; cltl2 の html を配置したパスを指定(w3mから参照できる形式)
(setq cltl2-root-url "file:///home/.emacs.d/cl-docs/cltl/")

(defadvice cltl2-lookup (around cltl2-lookup-by-w3m () activate)
  (let* ((window-configuration (current-window-configuration))
         (browse-url-browser-function
          `(lambda (url new-window)
             (w3m-browse-url url nil)
             (let ((cltl2-map (copy-keymap w3m-mode-map)))
               (define-key cltl2-map (kbd "q")
                 (lambda ()
                   (interactive)
                   (kill-buffer nil)
                   (set-window-configuration ,window-configuration)))
               (use-local-map cltl2-map)))))
    ad-do-it))


;; --------------------------------
;; Hyperspec と cltl2 を helm から引く
;; --------------------------------

(eval-after-load "helm"
  '(progn
     (setq helm-c-source-hyperspec
           `((name . "Lookup Hyperspec")
             (candidates . (lambda ()
                             (let ((symbols nil))
                               (mapatoms #'(lambda (sym) (push (symbol-name sym) symbols))
                                         imple-common-lisp-hyperspec-symbols)
                               symbols)))
             (action . (("Show Hyperspec" . hyperspec-lookup)))))

     (setq helm-c-source-cltl2
           `((name . "Lookup CLTL2")
             (candidates . (lambda ()
                             (let ((symbols nil))
                               (mapatoms #'(lambda (sym) (push (symbol-name sym) symbols))
                                         cltl2-symbols)
                               symbols)))
             (action . (("Show CLTL2" . cltl2-lookup)))))

     (defun helm-hyperspec-and-cltl2 ()
       (interactive)
        (helm '(helm-c-source-hyperspec helm-c-source-cltl2) (thing-at-point 'symbol)))))

(global-set-key "\C-cH" 'helm-hyperspec-and-cltl2)


;; 2014/05/11
;; 以下、slime2.4 からバージョンアップしたら
;; HyperSpecが引けなくなったので、旧 hyperspec.el から移植

(defvar imple-common-lisp-hyperspec-symbols (make-vector 67 0))

(defun imple-intern-clhs-symbol (string relative-url)
  (let ((symbol (intern string imple-common-lisp-hyperspec-symbols)))
    (if (boundp symbol)
        (push relative-url (symbol-value symbol))
        (set symbol (list relative-url)))))

(defun imple-hyperspec--get-one-line ()
  (prog1 
      (delete* ?\n (thing-at-point 'line))
    (forward-line)))

(defun imple-hyperspec-make-symbles ()
  (if common-lisp-hyperspec-symbol-table
      (with-current-buffer (find-file-noselect 
                            common-lisp-hyperspec-symbol-table)
        (goto-char (point-min))
        (while (< (point) (point-max))
          (let* ((symbol-name (downcase (imple-hyperspec--get-one-line)))
                 (relative-url (imple-hyperspec--get-one-line)))
            (imple-intern-clhs-symbol symbol-name 
                                      (subseq relative-url
                                              (1+ (position ?\/ relative-url
                                                            :from-end t))))))
        (kill-buffer (current-buffer)))))

(imple-hyperspec-make-symbles)