Klimi's new dotfiles with stow.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

156 lines
5.6 KiB

(require 'slime)
(require 'advice)
(require 'slime-compiler-notes-tree) ; FIXME: actually only uses the tree bits, so that should be a library.
(define-slime-contrib slime-references
"Clickable references to documentation (SBCL only)."
(:authors "Christophe Rhodes <csr21@cantab.net>"
"Luke Gorrie <luke@bluetail.com>"
"Tobias C. Rittweiler <tcr@freebits.de>")
(:license "GPL")
(:on-load
(ad-enable-advice 'slime-note.message 'after 'slime-note.message+references)
(ad-activate 'slime-note.message)
(setq slime-tree-printer 'slime-tree-print-with-references)
(add-hook 'sldb-extras-hooks 'sldb-maybe-insert-references))
(:on-unload
(ad-disable-advice 'slime-note.message 'after 'slime-note.message+references)
(ad-deactivate 'slime-note.message)
(setq slime-tree-printer 'slime-tree-default-printer)
(remove-hook 'sldb-extras-hooks 'sldb-maybe-insert-references)))
(defcustom slime-sbcl-manual-root "http://www.sbcl.org/manual/"
"*The base URL of the SBCL manual, for documentation lookup."
:type '(choice (string :tag "HTML Documentation")
(const :tag "Info Documentation" :info))
:group 'slime-mode)
(defface sldb-reference-face
(list (list t '(:underline t)))
"Face for references."
:group 'slime-debugger)
;;;;; SBCL-style references
(defvar slime-references-local-keymap
(let ((map (make-sparse-keymap "local keymap for slime references")))
(define-key map [mouse-2] 'slime-lookup-reference-at-mouse)
(define-key map [return] 'slime-lookup-reference-at-point)
map))
(defun slime-reference-properties (reference)
"Return the properties for a reference.
Only add clickability to properties we actually know how to lookup."
(cl-destructuring-bind (where type what) reference
(if (or (and (eq where :sbcl) (eq type :node))
(and (eq where :ansi-cl)
(memq type '(:function :special-operator :macro
:type :system-class
:section :glossary :issue))))
`(slime-reference ,reference
font-lock-face sldb-reference-face
follow-link t
mouse-face highlight
help-echo "mouse-2: visit documentation."
keymap ,slime-references-local-keymap))))
(defun slime-insert-reference (reference)
"Insert documentation reference from a condition.
See SWANK-BACKEND:CONDITION-REFERENCES for the datatype."
(cl-destructuring-bind (where type what) reference
(insert "\n" (slime-format-reference-source where) ", ")
(slime-insert-propertized (slime-reference-properties reference)
(slime-format-reference-node what))
(insert (format " [%s]" type))))
(defun slime-insert-references (references)
(when references
(insert "\nSee also:")
(slime-with-rigid-indentation 2
(mapc #'slime-insert-reference references))))
(defun slime-format-reference-source (where)
(cl-case where
(:amop "The Art of the Metaobject Protocol")
(:ansi-cl "Common Lisp Hyperspec")
(:sbcl "SBCL Manual")
(t (format "%S" where))))
(defun slime-format-reference-node (what)
(if (listp what)
(mapconcat #'prin1-to-string what ".")
what))
(defun slime-lookup-reference-at-point ()
"Browse the documentation reference at point."
(interactive)
(let ((refs (get-text-property (point) 'slime-reference)))
(if (null refs)
(error "No references at point")
(cl-destructuring-bind (where type what) refs
(cl-case where
(:ansi-cl
(cl-case type
(:section
(browse-url (funcall common-lisp-hyperspec-section-fun what)))
(:glossary
(browse-url (funcall common-lisp-hyperspec-glossary-function what)))
(:issue
(browse-url (common-lisp-issuex what)))
(:special-operator
(browse-url (common-lisp-special-operator (downcase name))))
(t
(hyperspec-lookup what))))
(t
(case slime-sbcl-manual-root
(:info
(info (format "(sbcl)%s" what)))
(t
(browse-url
(format "%s#%s" slime-sbcl-manual-root
(subst-char-in-string ?\ ?\- what)))))))))))
(defun slime-lookup-reference-at-mouse (event)
"Invoke the action pointed at by the mouse."
(interactive "e")
(cl-destructuring-bind (mouse-1 (w pos . _) . _) event
(save-excursion
(goto-char pos)
(slime-lookup-reference-at-point))))
;;;;; Hook into *SLIME COMPILATION*
(defun slime-note.references (note)
(plist-get note :references))
;;; FIXME: `compilation-mode' will swallow the `mouse-face'
;;; etc. properties.
(defadvice slime-note.message (after slime-note.message+references)
(setq ad-return-value
(concat ad-return-value
(with-temp-buffer
(slime-insert-references
(slime-note.references (ad-get-arg 0)))
(buffer-string)))))
;;;;; Hook into slime-compiler-notes-tree
(defun slime-tree-print-with-references (tree)
;; for SBCL-style references
(slime-tree-default-printer tree)
(let ((note (plist-get (slime-tree.plist tree) 'note)))
(when note
(let ((references (slime-note.references note)))
(when references
(terpri (current-buffer))
(slime-insert-references references))))))
;;;;; Hook into SLDB
(defun sldb-maybe-insert-references (extra)
(slime-dcase extra
((:references references) (slime-insert-references references) t)
(t nil)))
(provide 'slime-references)