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.
 
 
 
 
 
 

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)