summaryrefslogtreecommitdiff
path: root/vim/bundle/slimv/slime/contrib/swank-clipboard.lisp
blob: 52b108583f2c0e5aa5ca7707eca57408b57bed98 (plain)
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
;;; 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)