summaryrefslogtreecommitdiff
path: root/vim/bundle/slimv/slime/contrib/swank-clipboard.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'vim/bundle/slimv/slime/contrib/swank-clipboard.lisp')
-rw-r--r--vim/bundle/slimv/slime/contrib/swank-clipboard.lisp71
1 files changed, 71 insertions, 0 deletions
diff --git a/vim/bundle/slimv/slime/contrib/swank-clipboard.lisp b/vim/bundle/slimv/slime/contrib/swank-clipboard.lisp
new file mode 100644
index 0000000..52b1085
--- /dev/null
+++ b/vim/bundle/slimv/slime/contrib/swank-clipboard.lisp
@@ -0,0 +1,71 @@
+;;; swank-clipboard.lisp --- Object clipboard
+;;
+;; Written by Helmut Eller in 2008.
+;; License: Public Domain
+
+(defpackage :swank-clipboard
+ (:use :cl)
+ (:import-from :swank :defslimefun :with-buffer-syntax :dcase)
+ (:export :add :delete-entry :entries :entry-to-ref :ref))
+
+(in-package :swank-clipboard)
+
+(defstruct clipboard entries (counter 0))
+
+(defvar *clipboard* (make-clipboard))
+
+(defslimefun add (datum)
+ (let ((value (dcase datum
+ ((:string string package)
+ (with-buffer-syntax (package)
+ (eval (read-from-string string))))
+ ((:inspector part)
+ (swank:inspector-nth-part part))
+ ((:sldb frame var)
+ (swank/backend:frame-var-value frame var)))))
+ (clipboard-add value)
+ (format nil "Added: ~a"
+ (entry-to-string (1- (length (clipboard-entries *clipboard*)))))))
+
+(defslimefun entries ()
+ (loop for (ref . value) in (clipboard-entries *clipboard*)
+ collect `(,ref . ,(to-line value))))
+
+(defslimefun delete-entry (entry)
+ (let ((msg (format nil "Deleted: ~a" (entry-to-string entry))))
+ (clipboard-delete-entry entry)
+ msg))
+
+(defslimefun entry-to-ref (entry)
+ (destructuring-bind (ref . value) (clipboard-entry entry)
+ (list ref (to-line value 5))))
+
+(defun clipboard-add (value)
+ (setf (clipboard-entries *clipboard*)
+ (append (clipboard-entries *clipboard*)
+ (list (cons (incf (clipboard-counter *clipboard*))
+ value)))))
+
+(defun clipboard-ref (ref)
+ (let ((tail (member ref (clipboard-entries *clipboard*) :key #'car)))
+ (cond (tail (cdr (car tail)))
+ (t (error "Invalid clipboard ref: ~s" ref)))))
+
+(defun clipboard-entry (entry)
+ (elt (clipboard-entries *clipboard*) entry))
+
+(defun clipboard-delete-entry (index)
+ (let* ((list (clipboard-entries *clipboard*))
+ (tail (nthcdr index list)))
+ (setf (clipboard-entries *clipboard*)
+ (append (ldiff list tail) (cdr tail)))))
+
+(defun entry-to-string (entry)
+ (destructuring-bind (ref . value) (clipboard-entry entry)
+ (format nil "#@~d(~a)" ref (to-line value))))
+
+(defun to-line (object &optional (width 75))
+ (with-output-to-string (*standard-output*)
+ (write object :right-margin width :lines 1)))
+
+(provide :swank-clipboard)