/[slime]/slime/contrib/slime-clipboard.el
ViewVC logotype

Contents of /slime/contrib/slime-clipboard.el

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.8 - (show annotations)
Fri May 28 19:13:17 2010 UTC (3 years, 10 months ago) by heller
Branch: MAIN
CVS Tags: SLIME-2-3, FAIRLY-STABLE, byte-stream, SLIME-2-2, HEAD
Changes since 1.7: +1 -1 lines
Call provide at the end of the file.

* slime-asdf.el slime-banner.el slime-clipboard.el
slime-compiler-notes-tree.el slime-enclosing-context.el
slime-highlight-edits.el slime-hyperdoc.el slime-indentation.el
slime-mdot-fu.el slime-motd.el slime-mrepl.el
slime-presentation-streams.el slime-sbcl-exts.el slime-snapshot.el
slime-sprof.el slime-tramp.el slime-typeout-frame.el
slime-xref-browser.el:
1
2 (define-slime-contrib slime-clipboard
3 "This add a few commands to put objects into a clipboard and to
4 insert textual references to those objects.
5
6 The clipboard command prefix is C-c @.
7
8 C-c @ + adds an object to the clipboard
9 C-c @ @ inserts a reference to an object in the clipboard
10 C-c @ ? displays the clipboard
11
12 This package also also binds the + key in the inspector and
13 debugger to add the object at point to the clipboard."
14 (:authors "Helmut Eller <heller@common-lisp.net>")
15 (:license "GPL")
16 (:swank-dependencies swank-clipboard))
17
18 (define-derived-mode slime-clipboard-mode fundamental-mode
19 "Slime-Clipboard"
20 "SLIME Clipboad Mode.
21
22 \\{slime-clipboard-mode-map}")
23
24 (slime-define-keys slime-clipboard-mode-map
25 ("g" 'slime-clipboard-redisplay)
26 ((kbd "C-k") 'slime-clipboard-delete-entry)
27 ("i" 'slime-clipboard-inspect))
28
29 (defvar slime-clipboard-map (make-sparse-keymap))
30
31 (slime-define-keys slime-clipboard-map
32 ("?" 'slime-clipboard-display)
33 ("+" 'slime-clipboard-add)
34 ("@" 'slime-clipboard-ref))
35
36 (define-key slime-mode-map (kbd "C-c @") slime-clipboard-map)
37 (define-key slime-repl-mode-map (kbd "C-c @") slime-clipboard-map)
38
39 (slime-define-keys slime-inspector-mode-map
40 ("+" 'slime-clipboard-add-from-inspector))
41
42 (slime-define-keys sldb-mode-map
43 ("+" 'slime-clipboard-add-from-sldb))
44
45 (defun slime-clipboard-add (exp package)
46 "Add an object to the clipboard."
47 (interactive (list (slime-read-from-minibuffer
48 "Add to clipboard (evaluated): "
49 (slime-sexp-at-point))
50 (slime-current-package)))
51 (slime-clipboard-add-internal `(:string ,exp ,package)))
52
53 (defun slime-clipboard-add-internal (datum)
54 (slime-eval-async `(swank-clipboard:add ',datum)
55 (lambda (result) (message "%s" result))))
56
57 (defun slime-clipboard-display ()
58 "Display the content of the clipboard."
59 (interactive)
60 (slime-eval-async `(swank-clipboard:entries)
61 #'slime-clipboard-display-entries))
62
63 (defun slime-clipboard-display-entries (entries)
64 (slime-with-popup-buffer ((slime-buffer-name :clipboard)
65 :mode 'slime-clipboard-mode)
66 (slime-clipboard-insert-entries entries)))
67
68 (defun slime-clipboard-insert-entries (entries)
69 (let ((fstring "%2s %3s %s\n"))
70 (insert (format fstring "Nr" "Id" "Value")
71 (format fstring "--" "--" "-----" ))
72 (save-excursion
73 (loop for i from 0 for (ref . value) in entries do
74 (slime-insert-propertized `(slime-clipboard-entry ,i
75 slime-clipboard-ref ,ref)
76 (format fstring i ref value))))))
77
78 (defun slime-clipboard-redisplay ()
79 "Update the clipboard buffer."
80 (interactive)
81 (slime-eval-async
82 `(swank-clipboard:entries)
83 (lambda (entries)
84 (let ((inhibit-read-only t))
85 (slime-save-coordinates (point)
86 (erase-buffer)
87 (slime-clipboard-insert-entries entries))))))
88
89 (defun slime-clipboard-entry-at-point ()
90 (or (get-text-property (point) 'slime-clipboard-entry)
91 (error "No clipboard entry at point")))
92
93 (defun slime-clipboard-ref-at-point ()
94 (or (get-text-property (point) 'slime-clipboard-ref)
95 (error "No clipboard ref at point")))
96
97 (defun slime-clipboard-inspect (&optional entry)
98 "Inspect the current clipboard entry."
99 (interactive (list (slime-clipboard-ref-at-point)))
100 (slime-inspect (prin1-to-string `(swank-clipboard::clipboard-ref ,entry))))
101
102 (defun slime-clipboard-delete-entry (&optional entry)
103 "Delete the current entry from the clipboard."
104 (interactive (list (slime-clipboard-entry-at-point)))
105 (slime-eval-async `(swank-clipboard:delete-entry ,entry)
106 (lambda (result)
107 (slime-clipboard-redisplay)
108 (message "%s" result))))
109
110 (defun slime-clipboard-ref ()
111 "Ask for a clipboard entry number and insert a reference to it."
112 (interactive)
113 (slime-clipboard-read-entry-number #'slime-clipboard-insert-ref))
114
115 ;; insert a reference to clipboard entry ENTRY at point. The text
116 ;; receives a special 'display property to make it look nicer. We
117 ;; remove this property in a modification when a user tries to modify
118 ;; he real text.
119 (defun slime-clipboard-insert-ref (entry)
120 (destructuring-bind (ref . string)
121 (slime-eval `(swank-clipboard:entry-to-ref ,entry))
122 (slime-insert-propertized
123 `(display ,(format "#@%d%s" ref string)
124 modification-hooks (slime-clipboard-ref-modified)
125 rear-nonsticky t)
126 (format "(swank-clipboard::clipboard-ref %d)" ref))))
127
128 (defun slime-clipboard-ref-modified (start end)
129 (when (get-text-property start 'display)
130 (let ((inhibit-modification-hooks t))
131 (save-excursion
132 (goto-char start)
133 (destructuring-bind (dstart dend) (slime-property-bounds 'display)
134 (unless (and (= start dstart) (= end dend))
135 (remove-list-of-text-properties
136 dstart dend '(display modification-hooks))))))))
137
138 ;; Read a entry number.
139 ;; Written in CPS because the display the clipboard before reading.
140 (defun slime-clipboard-read-entry-number (k)
141 (slime-eval-async
142 `(swank-clipboard:entries)
143 (slime-rcurry
144 (lambda (entries window-config k)
145 (slime-clipboard-display-entries entries)
146 (let ((entry (unwind-protect
147 (read-from-minibuffer "Entry number: " nil nil t)
148 (set-window-configuration window-config))))
149 (funcall k entry)))
150 (current-window-configuration)
151 k)))
152
153 (defun slime-clipboard-add-from-inspector ()
154 (interactive)
155 (let ((part (or (get-text-property (point) 'slime-part-number)
156 (error "No part at point"))))
157 (slime-clipboard-add-internal `(:inspector ,part))))
158
159 (defun slime-clipboard-add-from-sldb ()
160 (interactive)
161 (slime-clipboard-add-internal
162 `(:sldb ,(sldb-frame-number-at-point)
163 ,(sldb-var-number-at-point))))
164
165 (provide 'slime-clipboard)

  ViewVC Help
Powered by ViewVC 1.1.5