;; [From my excessive .emacs: used for cut-buffers below.]
(require 'cl)
(defmacro table (var count form)
	"Evaluate FORM COUNT times, with VAR bound to integers from 0 to COUNT-1.
Return a list of the results obtained.
If VAR is `nil', bind nothing, just loop."
	(let ((listsym (gensym "table::list"))
				(tailsym (gensym "table::tail"))
				(iterator (or var (gensym "table::iterator")))
				(countsym (gensym "table::count")))
		`(let* ((,iterator -1) (,countsym ,count)
						(,listsym (list nil)) (,tailsym ,listsym))
			 (while (< (setq ,iterator (1+ ,iterator)) ,countsym)
				 (setq ,tailsym (setcdr ,tailsym (list ,form))))
			 (cdr ,listsym))))

(defvar x-selection-errors nil)

(defun x-get-selection-no-error (sel type)
	(condition-case e (x-get-selection-internal sel type)
		(error (add-to-list 'x-selection-errors e t) nil)))

(defun x-selection-report (s)
	(list s (x-selection-owner-p s)
				(let ((ct (x-get-selection-no-error s 'COMPOUND_TEXT))
							(str (x-get-selection-no-error s 'STRING)))
					(if ct (list 'COMPOUND_TEXT ct) (list 'STRING str)))))

(defvar x-selection-counter 0)

(defun x-describe-selections (&rest ignore)	; allow use on any hook
	(interactive)
	(with-current-buffer (get-buffer-create "*X Selections*")
		(erase-buffer)
		(pp (list (list (format "%-3s"
														(make-string (setq x-selection-counter
																							 (% (1+ x-selection-counter) 4)) ?*))
										(input-pending-p))
							(x-selection-report 'CLIPBOARD)
							(x-selection-report 'PRIMARY)
							(x-selection-report 'SECONDARY)
							(table i 8 (cons i (x-get-cut-buffer i)))) (current-buffer))))

;; Returns a lambda which pretty-prints list of its arguments with a header
(defun pp-lambda (buf str)
	`(lambda (&rest args)
		 (with-current-buffer (get-buffer-create ,buf)
			 (goto-char (point-max))
			 (insert ,str " at " (current-time-string) ": ")
			 (pp args (current-buffer)))))

(add-hook 'post-command-hook 'x-describe-selections)
(setq x-selection-timer (run-with-timer 0 0.25 'x-describe-selections))
(add-hook 'x-sent-selection-hooks
					(pp-lambda "*X Selection News*" "Sent selection"))
(add-hook 'x-lost-selection-hooks
					(pp-lambda "*X Selection News*" "Lost selection"))
(add-hook 'x-sent-selection-hooks 'x-describe-selections)
(add-hook 'x-lost-selection-hooks 'x-describe-selections)

;; For use with `eval-last-sexp'
;; (x-own-selection-internal 'CLIPBOARD "foo")
;; (x-own-selection-internal 'PRIMARY "bar")
;; (x-disown-selection-internal 'CLIPBOARD)
;; (x-disown-selection-internal 'PRIMARY)
;; (cancel-timer x-selection-timer)