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.
172 lines
5.9 KiB
172 lines
5.9 KiB
(require 'slime)
|
|
(require 'slime-repl)
|
|
(require 'cl-lib)
|
|
(eval-when-compile
|
|
(require 'cl)) ; lexical-let
|
|
|
|
(define-slime-contrib slime-clipboard
|
|
"This add a few commands to put objects into a clipboard and to
|
|
insert textual references to those objects.
|
|
|
|
The clipboard command prefix is C-c @.
|
|
|
|
C-c @ + adds an object to the clipboard
|
|
C-c @ @ inserts a reference to an object in the clipboard
|
|
C-c @ ? displays the clipboard
|
|
|
|
This package also also binds the + key in the inspector and
|
|
debugger to add the object at point to the clipboard."
|
|
(:authors "Helmut Eller <heller@common-lisp.net>")
|
|
(:license "GPL")
|
|
(:swank-dependencies swank-clipboard))
|
|
|
|
(define-derived-mode slime-clipboard-mode fundamental-mode
|
|
"Slime-Clipboard"
|
|
"SLIME Clipboad Mode.
|
|
|
|
\\{slime-clipboard-mode-map}")
|
|
|
|
(slime-define-keys slime-clipboard-mode-map
|
|
("g" 'slime-clipboard-redisplay)
|
|
((kbd "C-k") 'slime-clipboard-delete-entry)
|
|
("i" 'slime-clipboard-inspect))
|
|
|
|
(defvar slime-clipboard-map (make-sparse-keymap))
|
|
|
|
(slime-define-keys slime-clipboard-map
|
|
("?" 'slime-clipboard-display)
|
|
("+" 'slime-clipboard-add)
|
|
("@" 'slime-clipboard-ref))
|
|
|
|
(define-key slime-mode-map (kbd "C-c @") slime-clipboard-map)
|
|
(define-key slime-repl-mode-map (kbd "C-c @") slime-clipboard-map)
|
|
|
|
(slime-define-keys slime-inspector-mode-map
|
|
("+" 'slime-clipboard-add-from-inspector))
|
|
|
|
(slime-define-keys sldb-mode-map
|
|
("+" 'slime-clipboard-add-from-sldb))
|
|
|
|
(defun slime-clipboard-add (exp package)
|
|
"Add an object to the clipboard."
|
|
(interactive (list (slime-read-from-minibuffer
|
|
"Add to clipboard (evaluated): "
|
|
(slime-sexp-at-point))
|
|
(slime-current-package)))
|
|
(slime-clipboard-add-internal `(:string ,exp ,package)))
|
|
|
|
(defun slime-clipboard-add-internal (datum)
|
|
(slime-eval-async `(swank-clipboard:add ',datum)
|
|
(lambda (result) (message "%s" result))))
|
|
|
|
(defun slime-clipboard-display ()
|
|
"Display the content of the clipboard."
|
|
(interactive)
|
|
(slime-eval-async `(swank-clipboard:entries)
|
|
#'slime-clipboard-display-entries))
|
|
|
|
(defun slime-clipboard-display-entries (entries)
|
|
(slime-with-popup-buffer ((slime-buffer-name :clipboard)
|
|
:mode 'slime-clipboard-mode)
|
|
(slime-clipboard-insert-entries entries)))
|
|
|
|
(defun slime-clipboard-insert-entries (entries)
|
|
(let ((fstring "%2s %3s %s\n"))
|
|
(insert (format fstring "Nr" "Id" "Value")
|
|
(format fstring "--" "--" "-----" ))
|
|
(save-excursion
|
|
(cl-loop for i from 0 for (ref . value) in entries do
|
|
(slime-insert-propertized `(slime-clipboard-entry ,i
|
|
slime-clipboard-ref ,ref)
|
|
(format fstring i ref value))))))
|
|
|
|
(defun slime-clipboard-redisplay ()
|
|
"Update the clipboard buffer."
|
|
(interactive)
|
|
(lexical-let ((saved (point)))
|
|
(slime-eval-async
|
|
`(swank-clipboard:entries)
|
|
(lambda (entries)
|
|
(let ((inhibit-read-only t))
|
|
(erase-buffer)
|
|
(slime-clipboard-insert-entries entries)
|
|
(when (< saved (point-max))
|
|
(goto-char saved)))))))
|
|
|
|
(defun slime-clipboard-entry-at-point ()
|
|
(or (get-text-property (point) 'slime-clipboard-entry)
|
|
(error "No clipboard entry at point")))
|
|
|
|
(defun slime-clipboard-ref-at-point ()
|
|
(or (get-text-property (point) 'slime-clipboard-ref)
|
|
(error "No clipboard ref at point")))
|
|
|
|
(defun slime-clipboard-inspect (&optional entry)
|
|
"Inspect the current clipboard entry."
|
|
(interactive (list (slime-clipboard-ref-at-point)))
|
|
(slime-inspect (prin1-to-string `(swank-clipboard::clipboard-ref ,entry))))
|
|
|
|
(defun slime-clipboard-delete-entry (&optional entry)
|
|
"Delete the current entry from the clipboard."
|
|
(interactive (list (slime-clipboard-entry-at-point)))
|
|
(slime-eval-async `(swank-clipboard:delete-entry ,entry)
|
|
(lambda (result)
|
|
(slime-clipboard-redisplay)
|
|
(message "%s" result))))
|
|
|
|
(defun slime-clipboard-ref ()
|
|
"Ask for a clipboard entry number and insert a reference to it."
|
|
(interactive)
|
|
(slime-clipboard-read-entry-number #'slime-clipboard-insert-ref))
|
|
|
|
;; insert a reference to clipboard entry ENTRY at point. The text
|
|
;; receives a special 'display property to make it look nicer. We
|
|
;; remove this property in a modification when a user tries to modify
|
|
;; he real text.
|
|
(defun slime-clipboard-insert-ref (entry)
|
|
(cl-destructuring-bind (ref . string)
|
|
(slime-eval `(swank-clipboard:entry-to-ref ,entry))
|
|
(slime-insert-propertized
|
|
`(display ,(format "#@%d%s" ref string)
|
|
modification-hooks (slime-clipboard-ref-modified)
|
|
rear-nonsticky t)
|
|
(format "(swank-clipboard::clipboard-ref %d)" ref))))
|
|
|
|
(defun slime-clipboard-ref-modified (start end)
|
|
(when (get-text-property start 'display)
|
|
(let ((inhibit-modification-hooks t))
|
|
(save-excursion
|
|
(goto-char start)
|
|
(cl-destructuring-bind (dstart dend) (slime-property-bounds 'display)
|
|
(unless (and (= start dstart) (= end dend))
|
|
(remove-list-of-text-properties
|
|
dstart dend '(display modification-hooks))))))))
|
|
|
|
;; Read a entry number.
|
|
;; Written in CPS because the display the clipboard before reading.
|
|
(defun slime-clipboard-read-entry-number (k)
|
|
(slime-eval-async
|
|
`(swank-clipboard:entries)
|
|
(slime-rcurry
|
|
(lambda (entries window-config k)
|
|
(slime-clipboard-display-entries entries)
|
|
(let ((entry (unwind-protect
|
|
(read-from-minibuffer "Entry number: " nil nil t)
|
|
(set-window-configuration window-config))))
|
|
(funcall k entry)))
|
|
(current-window-configuration)
|
|
k)))
|
|
|
|
(defun slime-clipboard-add-from-inspector ()
|
|
(interactive)
|
|
(let ((part (or (get-text-property (point) 'slime-part-number)
|
|
(error "No part at point"))))
|
|
(slime-clipboard-add-internal `(:inspector ,part))))
|
|
|
|
(defun slime-clipboard-add-from-sldb ()
|
|
(interactive)
|
|
(slime-clipboard-add-internal
|
|
`(:sldb ,(sldb-frame-number-at-point)
|
|
,(sldb-var-number-at-point))))
|
|
|
|
(provide 'slime-clipboard)
|