Book a Demo!
CoCalc Logo Icon
StoreFeaturesDocsShareSupportNewsAboutPoliciesSign UpSign In
marvel
GitHub Repository: marvel/qnf
 Path: blob/master/elisp/slime/contrib/swank-clipboard.lisp
990 views
1
;;; swank-clipboard.lisp --- Object clipboard

2
;;

3
;; Written by Helmut Eller in 2008.

4
;; License: Public Domain

5


6
(defpackage :swank-clipboard

7
  (:use :cl)

8
  (:import-from :swank :defslimefun :with-buffer-syntax :destructure-case)

9
  (:export :add :delete-entry :entries :entry-to-ref :ref))

10


11
(in-package :swank-clipboard)

12


13
(defstruct clipboard entries (counter 0))

14


15
(defvar *clipboard* (make-clipboard))

16


17
(defslimefun add (datum)

18
  (let ((value (destructure-case datum

19
		 ((:string string package)

20
		  (with-buffer-syntax (package)

21
		    (eval (read-from-string string))))

22
		 ((:inspector part) 

23
		  (swank:inspector-nth-part part))

24
		 ((:sldb frame var)

25
		  (swank-backend:frame-var-value frame var)))))

26
    (clipboard-add value)

27
    (format nil "Added: ~a"

28
	    (entry-to-string (1- (length (clipboard-entries *clipboard*)))))))

29


30
(defslimefun entries ()

31
  (loop for (ref . value) in (clipboard-entries *clipboard*)

32
	collect `(,ref . ,(to-line value))))

33


34
(defslimefun delete-entry (entry)

35
  (let ((msg (format nil "Deleted: ~a" (entry-to-string entry))))

36
    (clipboard-delete-entry entry)

37
    msg))

38


39
(defslimefun entry-to-ref (entry)

40
  (destructuring-bind (ref . value) (clipboard-entry entry)

41
    (list ref (to-line value 5))))

42


43
(defun clipboard-add (value)

44
  (setf (clipboard-entries *clipboard*)

45
	(append (clipboard-entries *clipboard*) 

46
		(list (cons (incf (clipboard-counter *clipboard*))

47
			    value)))))

48


49
(defun clipboard-ref (ref)

50
  (let ((tail (member ref (clipboard-entries *clipboard*) :key #'car)))

51
    (cond (tail (cdr (car tail)))

52
	  (t (error "Invalid clipboard ref: ~s" ref)))))

53


54
(defun clipboard-entry (entry)

55
  (elt (clipboard-entries *clipboard*) entry))

56


57
(defun clipboard-delete-entry (index)

58
  (let* ((list (clipboard-entries *clipboard*))

59
	 (tail (nthcdr index list)))

60
    (setf (clipboard-entries *clipboard*)

61
	  (append (ldiff list tail) (cdr tail)))))

62


63
(defun entry-to-string (entry)

64
  (destructuring-bind (ref . value) (clipboard-entry entry)

65
    (format nil "#@~d(~a)" ref (to-line value))))

66


67
(defun to-line  (object &optional (width 75))

68
  (with-output-to-string (*standard-output*)

69
    (write object :right-margin width :lines 1)))

70


71