/usr/share/emacs/site-lisp/elpa-src/slime-2.20/contrib/slime-references.el is in slime 2:2.20+dfsg-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 | (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 'string
: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 (funcall 'common-lisp-issuex what)))
(t
(hyperspec-lookup what))))
(t
(let ((url (format "%s#%s" slime-sbcl-manual-root
(subst-char-in-string ?\ ?\- what))))
(browse-url url))))))))
(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)
|