eclips.el improvements

[Ian Zimmerman]

;;; eclips.el --- periodically collect clipboard contents 

;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;; Copyright (C) Ian Zimmerman, May 2006

;;; History:

;; Version 2006-05-29 integrates XEmacs fixes from Toto Bonow, plus
;; protection with inhibit-quit of the code that manipulates the data
;; structure.  It is not clear that this is needed for timer functions,
;; but it shouldn't hurt.

;;; Commentary:

;; This module attempts to do for Emacs what Xclipboard does for bare X,
;; or what Klipper does for KDE.  It polls the clipboard (actually the
;; value of PRIMARY selection) and when it finds a new value it inserts
;; it into a kill ring-like data structure.  Also, a minor mode is
;; provided to yank the saved bits, aping the normal Emacs yank and
;; yank-pop.

;;; Code:

;;;###autoload
(defgroup eclips nil
  "Keeping history of clipboard contents."
  :group 'environment
  :prefix "eclips-")

;;;###autoload
(defcustom eclips-ignored-clipboard-size 4096
  "*Clipboard contents larger than this value are ignored."
  :group 'eclips
  :type 'integer)

;;;###autoload
(defcustom eclips-history-max 128
  "*Maximum length of clipboard history before oldest elements are thrown away."
  :type 'integer
  :group 'eclips)

;;;###autoload
(defcustom eclips-timer-interval 1
  "*Interval in seconds between successive samplings of the clipboard."
  :group 'eclips
  :type 'integer)



(defsubst eclips-make-link (prev next str)
  (vector prev next str))

(defsubst eclips-link-prev (link)
  (aref link 0))

(defsubst eclips-link-next (link)
  (aref link 1))

(defsubst eclips-link-string (link)
  (aref link 2))

(defsubst eclips-link-set-prev (link prev)
  (aset link 0 prev))

(defsubst eclips-link-set-next (link next)
  (aset link 1 next))

(defsubst eclips-link-set-string (link str)
  (aset link 2 str))

(defsubst eclips-prefix-p (small big)
  (let ((l-small (length small))
        (l-big (length big)))
    (and (<= l-small l-big)
         (string-equal small (substring big 0 l-small)))))

(defsubst eclips-suffix-p (small big)
  (let ((l-small (length small))
        (l-big (length big)))
    (and (<= l-small l-big)
         (string-equal small (substring big (- l-small) l-big)))))

(defvar eclips-first-link nil
  "First link in a double linked list of clipboard contents.")

(defvar eclips-last-link nil
  "Last link in a double linked list of clipboard contents.")

(defvar eclips-num-links 0
  "Number of links in a double linked list of clipboard contents.")

(defvar eclips-hash (make-hash-table)
  "Hash with clipboard strings as keys and double links as elements.")

(defvar eclips-timer nil
  "Idle timer which collects clipboard contents.")

(defvar eclips-yank-pointer nil
  "The link of the clipboard history whose string is the last thing yanked.")

(defsubst eclips-get-selection ()
  (if (featurep 'xemacs)
      (condition-case nil
          (get-selection-foreign)
        (error nil))
    (x-get-selection)))  

(defun eclips-timer-function ()
  "Function that checks if clipoard contents has changed,
and if it has, adds the current contents to the collected history."
  (let ((inhibit-quit t)
        (current-sel (eclips-get-selection)))
    (cond
     ((not (stringp current-sel))
      nil)
     ((let ((ll (length current-sel)))
        (or (= 0 ll)
            (< eclips-ignored-clipboard-size ll)))
      nil)
     ((null eclips-first-link)
      (let ((link (eclips-make-link nil nil current-sel)))
        (setq eclips-first-link link)
        (setq eclips-last-link link)
        (setq eclips-num-links 1)
        (setq eclips-yank-pointer eclips-first-link)
        (puthash current-sel link eclips-hash)))
     ;; We're about to add to a non-empty history.  First check if the
     ;; last head of the list is a prefix or a suffix of the current
     ;; selection.  If it is, just replace the head with the current.
     ;; We do that because some programs (gtk-2.x?)  seem to change the
     ;; primary selection while the user is extending it, so if we don't
     ;; make this a special case we'll get a humongous number of
     ;; "different" selections all contained within one another.
     (t
      (let ((last-sel (eclips-link-string eclips-first-link)))
        (if (or (eclips-prefix-p last-sel current-sel)
                (eclips-suffix-p last-sel current-sel))
            (unless (string-equal last-sel current-sel)
              (remhash last-sel eclips-hash)
              (eclips-link-set-string eclips-first-link current-sel)
              (setq eclips-yank-pointer eclips-first-link)
              (puthash current-sel eclips-first-link eclips-hash))
          (let ((link (gethash current-sel eclips-hash)))
            (if (null link)
                (let ((link (eclips-make-link nil eclips-first-link 
current-sel)))
                  (eclips-link-set-prev eclips-first-link link)
                  (setq eclips-first-link link)
                  (setq eclips-yank-pointer eclips-first-link)
                  (puthash current-sel link eclips-hash)
                  (if (>= eclips-num-links eclips-history-max)
                      (let ((prev (eclips-link-prev eclips-last-link)))
                        (remhash (eclips-link-string eclips-last-link) 
eclips-hash)
                        (eclips-link-set-next prev nil)
                        (setq eclips-last-link prev))
                    (setq eclips-num-links (1+ eclips-num-links))))
              (let ((next (eclips-link-next link))
                    (prev (eclips-link-prev link)))
                (eclips-link-set-next prev next)
                (unless (null next)
                  (eclips-link-set-prev next prev))
                (eclips-link-set-prev eclips-first-link link)
                (eclips-link-set-prev link nil)
                (eclips-link-set-next link eclips-first-link)
                (setq eclips-yank-pointer link)
                (setq eclips-first-link link))))))))))                



;;;###autoload
(defun eclips-start-recording ()
  "Start collecting history of clipboard contents."
  (interactive)
  (if (null eclips-timer)
      (setq eclips-timer (run-at-time t eclips-timer-interval 
'eclips-timer-function))
    (message "Clipboard history is already being recorded")))

;;;###autoload
(defun eclips-stop-recording ()
  "Stop collecting history of clipboard contents."
  (interactive)
  (if eclips-timer
      (cancel-timer eclips-timer)
    (message "Clipboard history is not being recorded"))
  (setq eclips-timer nil))

;;;###autoload
(defun eclips-toggle-recording ()
  "Toggle collecting history of clipboard contents."
  (interactive)
  (if eclips-timer
      (eclips-stop-recording)
    (eclips-start-recording)))

;;;###autoload
(defun eclips-clear ()
  "Clear history of clipboard contents and free all associated data structures."
  (interactive)
  (let ((inhibit-quit t))
    (clrhash eclips-hash)
    (setq eclips-num-links 0)
    (setq eclips-first-link nil)
    (setq eclips-last-link nil)))

(defsubst eclips-forward-yank-pointer (n)
  (unless eclips-yank-pointer
    (error "Clipboard history yank pointer is not set"))
  (while (> n 0)
    (let ((next (eclips-link-next eclips-yank-pointer)))
      (setq eclips-yank-pointer
            (if (null next) eclips-first-link next)))
    (setq n (1- n))))

(defsubst eclips-backward-yank-pointer (n)
  (unless eclips-yank-pointer
    (error "Clipboard history yank pointer is not set"))
  (while (> n 0)
    (let ((prev (eclips-link-prev eclips-yank-pointer)))
      (setq eclips-yank-pointer
            (if (null prev) eclips-last-link prev)))
    (setq n (1- n))))

(defun eclips-current (n)
  "Rotate the clipboard yanking point by N places, and then return that text."
  (if (>= n 0)
      (eclips-forward-yank-pointer n)
    (eclips-backward-yank-pointer (- n)))
  (eclips-link-string eclips-yank-pointer))

(defsubst eclips-mark-marker ()
  "Compatibility function to act as a wrapper for XEmacs and GNU Emacs differing
`mark-marker' functions. The GNU Emacs version has no arguments, the XEmacs
version has to be called (here) with optional argument FORCE if `zmacs-region'
is active."
  (if (featurep 'xemacs)
      (mark-marker t)
    (mark-marker)))

;;;###autoload
(defun eclips-yank-pop (arg)
  "Replace just-yanked stretch of saved clipboard text with a different stretch.
This command is allowed only immediately after a `eclips-yank' or a
`eclips-yank-pop'.  At such a time, the region contains a stretch of
inserted clipboard text.  `eclips-yank-pop' deletes that text and
inserts in its place a different stretch of clipboard text.

With no argument, the latest clipboard text is inserted.
With argument N, insert the Nth previous bit of text from clipboard history.
If N is negative, this is a more recent bit of clipboard history.

The clipboard history wraps around, so that after the oldest one
comes the newest one."
  (interactive "*p")
  (if (not (eq last-command 'eclips-yank))
      (error "Previous command was not a clipboard yank"))
  (setq this-command 'eclips-yank)
  (let ((inhibit-read-only t)
        (before (< (point) (mark t))))
    (delete-region (point) (mark t))
    (set-marker (eclips-mark-marker) (point) (current-buffer))
    (let ((opoint (point)))
      (insert (eclips-current arg))
      (let ((inhibit-read-only t))
        (remove-text-properties opoint (point) '(read-only nil))))
    (if before
        ;; This is like exchange-point-and-mark, but doesn't activate the mark.
        ;; It is cleaner to avoid activation, even though the command
        ;; loop would deactivate the mark because we inserted text.
        (goto-char (prog1 (mark t)
                     (set-marker (eclips-mark-marker) (point) 
(current-buffer))))))
  nil)

;;;###autoload
(defun eclips-yank (&optional arg)
  "Insert the last stretch of saved clipboard text.
More precisely, reinsert the stretch of clipboard text most recently
saved OR yanked.  Put point at end, and set mark at beginning.
With just C-u as argument, same but put point at beginning (and mark at end).
With argument N, reinsert the Nth most recently saved stretch of clipboard
text.
See also the command \\[eclips-yank-pop]."
  (interactive "*P")
  ;; If we don't get all the way thru, make last-command indicate that
  ;; for the following command.
  (setq this-command t)
  (push-mark (point))
  (let ((opoint (point)))
    (insert (eclips-current (cond
                             ((listp arg) 0)
                             ((eq arg '-) -1)
                             (t (1- arg)))))
    (let ((inhibit-read-only t))
      (remove-text-properties opoint (point) '(read-only nil))))
  (if (consp arg)
      ;; This is like exchange-point-and-mark, but doesn't activate the mark.
      ;; It is cleaner to avoid activation, even though the command
      ;; loop would deactivate the mark because we inserted text.
      (goto-char (prog1 (mark t)
                   (set-marker (eclips-mark-marker) (point) (current-buffer)))))
  ;; If we do get all the way thru, make this-command indicate that.
  (setq this-command 'eclips-yank)
  nil)

;;;###autoload
(defun eclips-rotate-yank-pointer (arg)
  "Rotate the yanking point in the clipboard history.
With argument, rotate that many clipboard bits forward (or backward, if 
negative)."
  (interactive "p")
  (eclips-current arg))

(defvar eclips-mode nil
  "The global flag for the eclips minor mode.")

;;;###autoload
(defun eclips-mode (&optional arg)
  "Set or toggle the eclips minor mode.
\\<global-map>  This mode overrides the normal Emacs bindings for
\\[yank] and \\[yank-pop] with ones that are similar but based on
the saved clipboard history.
\\<eclips-mode-map>
\\[eclips-yank] - Insert the last stretch of saved clipboard text.
\\[eclips-yank-pop] - Replace just-yanked stretch of saved clipboard text with 
a different stretch."

  (interactive "P")
  (or (assq 'eclips-mode minor-mode-alist)
      (setq minor-mode-alist
            (cons '(eclips-mode " Eclips") minor-mode-alist)))
  (let ((goal
         (if (null arg) (not eclips-mode)
           (> (prefix-numeric-value arg) 0))))
    (if (or (and goal eclips-mode) (and (not goal) (not eclips-mode))) nil
      (setq eclips-mode (not (null goal)))
      (force-mode-line-update 'all))))

;;;###autoload
(defsubst turn-on-eclips-mode ()
  "Turn on the eclips minor mode."
  (interactive)
  (eclips-mode 1))

;;;###autoload
(defsubst turn-off-eclips-mode ()
  "Turn off the eclips minor mode."
  (interactive)
  (eclips-mode 0))

(defvar eclips-mode-map nil
  "Keymap used in eclips mode.")
(if eclips-mode-map
    ()
  (setq eclips-mode-map (make-sparse-keymap))
  (define-key eclips-mode-map "\C-y" 'eclips-yank)
  (define-key eclips-mode-map "\M-y" 'eclips-yank-pop))

(or (assq 'eclips-mode minor-mode-map-alist)
    (setq minor-mode-map-alist
          (cons (cons 'eclips-mode eclips-mode-map) minor-mode-map-alist)))

(provide 'eclips)

;;; eclips.el ends here