From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: joakim@verona.se Newsgroups: gmane.emacs.devel Subject: kill-ring visualization Date: Thu, 18 Mar 2010 07:18:29 +0100 Message-ID: NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: dough.gmane.org 1268893146 17147 80.91.229.12 (18 Mar 2010 06:19:06 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Thu, 18 Mar 2010 06:19:06 +0000 (UTC) To: Emacs development discussions Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Thu Mar 18 07:19:01 2010 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1Ns94D-0008HO-IJ for ged-emacs-devel@m.gmane.org; Thu, 18 Mar 2010 07:19:01 +0100 Original-Received: from localhost ([127.0.0.1]:34689 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1Ns94C-0007XE-5A for ged-emacs-devel@m.gmane.org; Thu, 18 Mar 2010 02:18:48 -0400 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1Ns945-0007Wb-EZ for emacs-devel@gnu.org; Thu, 18 Mar 2010 02:18:41 -0400 Original-Received: from [140.186.70.92] (port=35329 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1Ns941-0007Ti-Ew for emacs-devel@gnu.org; Thu, 18 Mar 2010 02:18:40 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.69) (envelope-from ) id 1Ns93x-0006Cl-4I for emacs-devel@gnu.org; Thu, 18 Mar 2010 02:18:37 -0400 Original-Received: from iwfs.imcode.com ([82.115.149.64]:43987 helo=gate.verona.se) by eggs.gnu.org with esmtp (Exim 4.69) (envelope-from ) id 1Ns93w-0006Ce-EI for emacs-devel@gnu.org; Thu, 18 Mar 2010 02:18:33 -0400 Original-Received: from localhost.localdomain (IDENT:1005@localhost [127.0.0.1]) by gate.verona.se (8.13.4/8.11.4) with ESMTP id o2I6ITtc016841 for ; Thu, 18 Mar 2010 07:18:29 +0100 User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/23.1.90 (gnu/linux) X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.4-2.6 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:122139 Archived-At: --=-=-= I find browse-kill-ring very convenient. It cleverly advices m-y so if its run before any preceding yank, it shows the contents of the kill-ring and the user can select one entry to be yanked. Could something like this be included in Emacs-24? I feel it would be useful to newcomers (and old-timers with bad short-term memory like me) The defadvices would have to be removed. I attach the lisp for inspection. --=-=-= Content-Type: text/plain; charset=iso-8859-15 Content-Disposition: inline; filename=browse-kill-ring.el Content-Transfer-Encoding: quoted-printable ;;; browse-kill-ring.el --- interactively insert items from kill-ring -*- c= oding: utf-8 -*- ;; Copyright (C) 2001, 2002 Colin Walters ;; Author: Colin Walters ;; Maintainer: Nick Hurley ;; Created: 7 Apr 2001 ;; Version: 1.3a (CVS) ;; X-RCS: $Id: browse-kill-ring.el,v 1.2 2008/10/29 00:23:00 hurley Exp $ ;; URL: http://freedom.cis.ohio-state.edu/~hurley/ ;; URL-ja: http://www.fan.gr.jp/~ring/doc/browse-kill-ring.html ;; Keywords: convenience ;; This file is not currently part of GNU Emacs. ;; This program 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 program 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 this program ; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;; Commentary: ;; Ever feel that 'C-y M-y M-y M-y ...' is not a great way of trying ;; to find that piece of text you know you killed a while back? Then ;; browse-kill-ring.el is for you. ;; This package is simple to install; add (require 'browse-kill-ring) ;; to your ~/.emacs file, after placing this file somewhere in your ;; `load-path'. If you want to use 'M-y' to invoke ;; `browse-kill-ring', also add (browse-kill-ring-default-keybindings) ;; to your ~/.emacs file. Alternatively, you can bind it to another ;; key such as "C-c k", with: ;; (global-set-key (kbd "C-c k") 'browse-kill-ring) ;; Note that the command keeps track of the last window displayed to ;; handle insertion of chosen text; this might have unexpected ;; consequences if you do 'M-x browse-kill-ring', then switch your ;; window configuration, and try to use the same *Kill Ring* buffer ;; again. ;;; Change Log: ;; Changes from 1.3 to 1.3a: ;; * Sneak update by Benjamin Andresen ;; * Added the read-only bugfix (http://bugs.debian.org/225082) from=20 ;; the emacs-goodies-el package ;; Changes from 1.2 to 1.3: ;; * New maintainer, Nick Hurley ;; * New functions `browse-kill-ring-prepend-insert', and ;; `browse-kill-ring-append-insert', bound to 'b' and 'a' by ;; default. There are also the unbound functions ;; `browse-kill-ring-prepend-insert-and-quit', ;; `browse-kill-ring-prepend-insert-and-move', ;; `browse-kill-ring-prepend-insert-move-and-quit', ;; `browse-kill-ring-append-insert-and-quit', ;; `browse-kill-ring-append-insert-and-move', ;; `browse-kill-ring-append-insert-move-and-quit'. ;; Changes from 1.1 to 1.2: ;; * New variable `browse-kill-ring-resize-window', which controls ;; whether or not the browse-kill-ring window will try to resize ;; itself to fit the buffer. Implementation from Juanma Barranquero ;; . ;; * New variable `browse-kill-ring-highlight-inserted-item'. ;; Implementation from Yasutaka SHINDOH . ;; * `browse-kill-ring-mouse-insert' (normally bound to mouse-2) now ;; calls `browse-kill-ring-quit'. ;; * Some non-user-visible code cleanup. ;; * New variable `browse-kill-ring-recenter', implementation from ;; Ren=E9 Kyllingstad . ;; * Patch from Michal Mar=A8uka which handles ;; read-only text better. ;; * New ability to move unkilled entries back to the beginning of the ;; ring; patch from Yasutaka SHINDOH . ;; * Do nothing if the user invokes `browse-kill-ring' when we're ;; already in a *Kill Ring* buffer (initial patch from Juanma ;; Barranquero ). ;; Changes from 1.0 to 1.1: ;; * Important keybinding change! The default bindings of RET and 'i' ;; have switched; this means typing RET now by default inserts the ;; text and calls `browse-kill-ring-quit'; 'i' just inserts. ;; * The variable `browse-kill-ring-use-fontification' is gone; ;; browse-kill-ring.el has been rewritten to use font-lock. XEmacs ;; users who want fontification will have to do: ;; (add-hook 'browse-kill-ring-hook 'font-lock-mode) ;; * Integrated code from Michael Slass into ;; `browse-kill-ring-default-keybindings'. ;; * New Japanese homepage for browse-kill-ring.el, thanks to ;; Yasutaka SHINDOH . ;; * Correctly restore window configuration after editing an entry. ;; * New command `browse-kill-ring-insert-and-delete'. ;; * Bug reports and patches from Michael Slass and ;; Juanma Barranquero . ;; Changes from 0.9b to 1.0: ;; * Add autoload cookie to `browse-kill-ring'; suggestion from ;; D. Goel and Dave Pearson . ;; * Add keybinding tip from Michael Slass . ;; Changes from 0.9a to 0.9b: ;; * Remove extra parenthesis. Duh. ;; Changes from 0.9 to 0.9a: ;; * Fix bug making `browse-kill-ring-quit-action' uncustomizable. ;; Patch from Henrik Enberg . ;; * Add `url-link' and `group' attributes to main Customization ;; group. ;; Changes from 0.8 to 0.9: ;; * Add new function `browse-kill-ring-insert-and-quit', bound to 'i' ;; by default (idea from Yasutaka Shindoh). ;; * Make default `browse-kill-ring-quit-action' be ;; `bury-and-delete-window', which handles the case of a single window ;; more nicely. ;; * Note change of home page and author address. ;; Changes from 0.7 to 0.8: ;; * Fix silly bug in `browse-kill-ring-edit' which made it impossible ;; to edit entries. ;; * New variable `browse-kill-ring-quit-action'. ;; * `browse-kill-ring-restore' renamed to `browse-kill-ring-quit'. ;; * Describe the keymaps in mode documentation. Patch from ;; Marko Slyz . ;; * Fix advice documentation for `browse-kill-ring-no-duplicates'. ;; Changes from 0.6 to 0.7: ;; * New functions `browse-kill-ring-search-forward' and ;; `browse-kill-ring-search-backward', bound to "s" and "r" by ;; default, respectively. ;; * New function `browse-kill-ring-edit' bound to "e" by default, and ;; a associated new major mode. ;; * New function `browse-kill-ring-occur', bound to "l" by default. ;; Changes from 0.5 to 0.6: ;; * Fix bug in `browse-kill-ring-forward' which sometimes would cause ;; a message "Wrong type argument: overlayp, nil" to appear. ;; * New function `browse-kill-ring-update'. ;; * New variable `browse-kill-ring-highlight-current-entry'. ;; * New variable `browse-kill-ring-display-duplicates'. ;; * New optional advice `browse-kill-ring-no-kill-new-duplicates', ;; and associated variable `browse-kill-ring-no-duplicates'. Code ;; from Klaus Berndl . ;; * Bind "?" to `describe-mode'. Patch from Dave Pearson ;; . ;; * Fix typo in `browse-kill-ring-display-style' defcustom form. ;; Thanks "Kahlil (Kal) HODGSON" . ;; Changes from 0.4 to 0.5: ;; * New function `browse-kill-ring-delete', bound to "d" by default. ;; * New function `browse-kill-ring-undo', bound to "U" by default. ;; * New variable `browse-kill-ring-maximum-display-length'. ;; * New variable `browse-kill-ring-use-fontification'. ;; * New variable `browse-kill-ring-hook', called after the ;; "*Kill Ring*" buffer is created. ;; Changes from 0.3 to 0.4: ;; * New functions `browse-kill-ring-forward' and ;; `browse-kill-ring-previous', bound to "n" and "p" by default, ;; respectively. ;; * Change the default `browse-kill-ring-display-style' to ;; `separated'. ;; * Removed `browse-kill-ring-original-window-config'; Now ;; `browse-kill-ring-restore' just buries the "*Kill Ring*" buffer ;; and deletes its window, which is simpler and more intuitive. ;; * New variable `browse-kill-ring-separator-face'. ;;; Bugs: ;; * Sometimes, in Emacs 21, the cursor will jump to the end of an ;; entry when moving backwards using `browse-kill-ring-previous'. ;; This doesn't seem to occur in Emacs 20 or XEmacs. ;;; Code: (eval-when-compile (require 'cl) (require 'derived)) (when (featurep 'xemacs) (require 'overlay)) (defun browse-kill-ring-depropertize-string (str) "Return a copy of STR with text properties removed." (let ((str (copy-sequence str))) (set-text-properties 0 (length str) nil str) str)) (cond ((fboundp 'propertize) (defalias 'browse-kill-ring-propertize 'propertize)) ;; Maybe save some memory :) ((fboundp 'ibuffer-propertize) (defalias 'browse-kill-ring-propertize 'ibuffer-propertize)) (t (defun browse-kill-ring-propertize (string &rest properties) "Return a copy of STRING with text properties added. [Note: this docstring has been copied from the Emacs 21 version] First argument is the string to copy. Remaining arguments form a sequence of PROPERTY VALUE pairs for text properties to add to the result." (let ((str (copy-sequence string))) (add-text-properties 0 (length str) properties str) str)))) (defgroup browse-kill-ring nil "A package for browsing and inserting the items in `kill-ring'." :link '(url-link "http://freedom.cis.ohio-state.edu/~hurley/") :group 'convenience) (defvar browse-kill-ring-display-styles '((separated . browse-kill-ring-insert-as-separated) (one-line . browse-kill-ring-insert-as-one-line))) (defcustom browse-kill-ring-display-style 'separated "How to display the kill ring items. If `one-line', then replace newlines with \"\\n\" for display. If `separated', then display `browse-kill-ring-separator' between entries." :type '(choice (const :tag "One line" one-line) (const :tag "Separated" separated)) :group 'browse-kill-ring) (defcustom browse-kill-ring-quit-action 'bury-and-delete-window "What action to take when `browse-kill-ring-quit' is called. If `bury-buffer', then simply bury the *Kill Ring* buffer, but keep the window. If `bury-and-delete-window', then bury the buffer, and (if there is more than one window) delete the window. This is the default. If `save-and-restore', then save the window configuration when `browse-kill-ring' is called, and restore it at quit. If `kill-and-delete-window', then kill the *Kill Ring* buffer, and delete the window on close. Otherwise, it should be a function to call." :type '(choice (const :tag "Bury buffer" :value bury-buffer) (const :tag "Delete window" :value delete-window) (const :tag "Save and restore" :value save-and-restore) (const :tag "Bury buffer and delete window" :value bury-and-delete-windo= w) (const :tag "Kill buffer and delete window" :value kill-and-delete-windo= w) function) :group 'browse-kill-ring) (defcustom browse-kill-ring-resize-window nil "Whether to resize the `browse-kill-ring' window to fit its contents. Value is either t, meaning yes, or a cons pair of integers, (MAXIMUM . MINIMUM) for the size of the window. MAXIMUM defaults to the window size chosen by `pop-to-buffer'; MINIMUM defaults to `window-min-height'." :type '(choice (const :tag "No" nil) (const :tag "Yes" t) (cons (integer :tag "Maximum") (integer :tag "Minimum"))) :group 'browse-kill-ring) (defcustom browse-kill-ring-separator "-------" "The string separating entries in the `separated' style. See `browse-kill-ring-display-style'." :type 'string :group 'browse-kill-ring) (defcustom browse-kill-ring-recenter nil "If non-nil, then always keep the current entry at the top of the window." :type 'boolean :group 'browse-kill-ring) (defcustom browse-kill-ring-highlight-current-entry nil "If non-nil, highlight the currently selected `kill-ring' entry." :type 'boolean :group 'browse-kill-ring) (defcustom browse-kill-ring-highlight-inserted-item browse-kill-ring-highli= ght-current-entry "If non-nil, temporarily highlight the inserted `kill-ring' entry." :type 'boolean :group 'browse-kill-ring) (defcustom browse-kill-ring-separator-face 'bold "The face in which to highlight the `browse-kill-ring-separator'." :type 'face :group 'browse-kill-ring) (defcustom browse-kill-ring-maximum-display-length nil "Whether or not to limit the length of displayed items. If this variable is an integer, the display of `kill-ring' will be limited to that many characters. Setting this variable to nil means no limit." :type '(choice (const :tag "None" nil) integer) :group 'browse-kill-ring) (defcustom browse-kill-ring-display-duplicates t "If non-nil, then display duplicate items in `kill-ring'." :type 'boolean :group 'browse-kill-ring) (defadvice kill-new (around browse-kill-ring-no-kill-new-duplicates) "An advice for not adding duplicate elements to `kill-ring'. Even after being \"activated\", this advice will only modify the behavior of `kill-new' when `browse-kill-ring-no-duplicates' is non-nil." (if browse-kill-ring-no-duplicates (setq kill-ring (delete (ad-get-arg 0) kill-ring))) ad-do-it) (defcustom browse-kill-ring-no-duplicates nil "If non-nil, then the `b-k-r-no-kill-new-duplicates' advice will operate. This means that duplicate entries won't be added to the `kill-ring' when you call `kill-new'. If you set this variable via customize, the advice will be activated or deactivated automatically. Otherwise, to enable the advice, add (ad-enable-advice 'kill-new 'around 'browse-kill-ring-no-kill-new-duplicat= es) (ad-activate 'kill-new) to your init file." :type 'boolean :set (lambda (symbol value) (set symbol value) (if value (ad-enable-advice 'kill-new 'around 'browse-kill-ring-no-kill-new-duplicates) (ad-disable-advice 'kill-new 'around 'browse-kill-ring-no-kill-new-duplicates)) (ad-activate 'kill-new)) :group 'browse-kill-ring) (defcustom browse-kill-ring-depropertize nil "If non-nil, remove text properties from `kill-ring' items. This only changes the items for display and insertion from `browse-kill-ring'; if you call `yank' directly, the items will be inserted with properties." :type 'boolean :group 'browse-kill-ring) (defcustom browse-kill-ring-hook nil "A list of functions to call after `browse-kill-ring'." :type 'hook :group 'browse-kill-ring) (defvar browse-kill-ring-original-window-config nil "The window configuration to restore for `browse-kill-ring-quit'.") (make-variable-buffer-local 'browse-kill-ring-original-window-config) (defvar browse-kill-ring-original-window nil "The window in which chosen kill ring data will be inserted. It is probably not a good idea to set this variable directly; simply call `browse-kill-ring' again.") (defun browse-kill-ring-mouse-insert (e) "Insert the chosen text, and close the *Kill Ring* buffer afterwards." (interactive "e") (let* ((data (save-excursion (mouse-set-point e) (cons (current-buffer) (point)))) (buf (car data)) (pt (cdr data))) (browse-kill-ring-do-insert buf pt)) (browse-kill-ring-quit)) (if (fboundp 'fit-window-to-buffer) (defalias 'browse-kill-ring-fit-window 'fit-window-to-buffer) (defun browse-kill-ring-fit-window (window max-height min-height) (setq min-height (or min-height window-min-height)) (setq max-height (or max-height (- (frame-height) (window-height) 1))) (let* ((window-min-height min-height) (windows (count-windows)) (config (current-window-configuration))) (enlarge-window (- max-height (window-height))) (when (> windows (count-windows)) (set-window-configuration config)) (if (/=3D (point-min) (point-max)) (shrink-window-if-larger-than-buffer window) (shrink-window (- (window-height) window-min-height)))))) (defun browse-kill-ring-resize-window () (when browse-kill-ring-resize-window (apply #'browse-kill-ring-fit-window (selected-window) (if (consp browse-kill-ring-resize-window) (list (car browse-kill-ring-resize-window) (or (cdr browse-kill-ring-resize-window) window-min-height)) (list nil window-min-height))))) (defun browse-kill-ring-undo-other-window () "Undo the most recent change in the other window's buffer. You most likely want to use this command for undoing an insertion of yanked text from the *Kill Ring* buffer." (interactive) (with-current-buffer (window-buffer browse-kill-ring-original-window) (undo))) (defun browse-kill-ring-insert (&optional quit) "Insert the kill ring item at point into the last selected buffer. If optional argument QUIT is non-nil, close the *Kill Ring* buffer as well." (interactive "P") (browse-kill-ring-do-insert (current-buffer) (point)) (when quit (browse-kill-ring-quit))) (defun browse-kill-ring-insert-and-delete (&optional quit) "Insert the kill ring item at point, and remove it from the kill ring. If optional argument QUIT is non-nil, close the *Kill Ring* buffer as well." (interactive "P") (browse-kill-ring-do-insert (current-buffer) (point)) (browse-kill-ring-delete) (when quit (browse-kill-ring-quit))) (defun browse-kill-ring-insert-and-quit () "Like `browse-kill-ring-insert', but close the *Kill Ring* buffer afterwa= rds." (interactive) (browse-kill-ring-insert t)) (defun browse-kill-ring-insert-and-move (&optional quit) "Like `browse-kill-ring-insert', but move the entry to the front." (interactive "P") (let ((buf (current-buffer)) (pt (point))) (browse-kill-ring-do-insert buf pt) (let ((str (browse-kill-ring-current-string buf pt))) (browse-kill-ring-delete) (kill-new str))) (if quit (browse-kill-ring-quit) (browse-kill-ring-update))) (defun browse-kill-ring-insert-move-and-quit () "Like `browse-kill-ring-insert-and-move', but close the *Kill Ring* buffe= r." (interactive) (browse-kill-ring-insert-and-move t)) (defun browse-kill-ring-prepend-insert (&optional quit) "Like `browse-kill-ring-insert', but it places the entry at the beginning of the buffer as opposed to point." (interactive "P") (browse-kill-ring-do-prepend-insert (current-buffer) (point)) (when quit (browse-kill-ring-quit))) (defun browse-kill-ring-prepend-insert-and-quit () "Like `browse-kill-ring-prepend-insert', but close the *Kill Ring* buffer= ." (interactive) (browse-kill-ring-prepend-insert t)) (defun browse-kill-ring-prepend-insert-and-move (&optional quit) "Like `browse-kill-ring-prepend-insert', but move the entry to the front of the *Kill Ring*." (interactive "P") (let ((buf (current-buffer)) (pt (point))) (browse-kill-ring-do-prepend-insert buf pt) (let ((str (browse-kill-ring-current-string buf pt))) (browse-kill-ring-delete) (kill-new str))) (if quit (browse-kill-ring-quit) (browse-kill-ring-update))) (defun browse-kill-ring-prepend-insert-move-and-quit () "Like `browse-kill-ring-prepend-insert-and-move', but close the *Kill Ring* buffer." (interactive) (browse-kill-ring-prepend-insert-and-move t)) (defun browse-kill-ring-do-prepend-insert (buf pt) (let ((str (browse-kill-ring-current-string buf pt))) (let ((orig (current-buffer))) (unwind-protect (progn (unless (window-live-p browse-kill-ring-original-window) (error "Window %s has been deleted; Try calling `browse-kill-ring' a= gain" browse-kill-ring-original-window)) (set-buffer (window-buffer browse-kill-ring-original-window)) (save-excursion (let ((pt (point))) (goto-char (point-min)) (insert (if browse-kill-ring-depropertize (browse-kill-ring-depropertize-string str) str)) (when browse-kill-ring-highlight-inserted-item (let ((o (make-overlay (point-min) (point)))) (overlay-put o 'face 'highlight) (sit-for 0.5) (delete-overlay o))) (goto-char pt)))) (set-buffer orig))))) (defun browse-kill-ring-append-insert (&optional quit) "Like `browse-kill-ring-insert', but places the entry at the end of the buffer as opposed to point." (interactive "P") (browse-kill-ring-do-append-insert (current-buffer) (point)) (when quit (browse-kill-ring-quit))) (defun browse-kill-ring-append-insert-and-quit () "Like `browse-kill-ring-append-insert', but close the *Kill Ring* buffer." (interactive) (browse-kill-ring-append-insert t)) (defun browse-kill-ring-append-insert-and-move (&optional quit) "Like `browse-kill-ring-append-insert', but move the entry to the front of the *Kill Ring*." (interactive "P") (let ((buf (current-buffer)) (pt (point))) (browse-kill-ring-do-append-insert buf pt) (let ((str (browse-kill-ring-current-string buf pt))) (browse-kill-ring-delete) (kill-new str))) (if quit (browse-kill-ring-quit) (browse-kill-ring-update))) (defun browse-kill-ring-append-insert-move-and-quit () "Like `browse-kill-ring-append-insert-and-move', but close the *Kill Ring* buffer." (interactive) (browse-kill-ring-append-insert-and-move t)) (defun browse-kill-ring-do-append-insert (buf pt) (let ((str (browse-kill-ring-current-string buf pt))) (let ((orig (current-buffer))) (unwind-protect (progn (unless (window-live-p browse-kill-ring-original-window) (error "Window %s has been deleted; Try calling `browse-kill-ring' a= gain" browse-kill-ring-original-window)) (set-buffer (window-buffer browse-kill-ring-original-window)) (save-excursion (let ((pt (point)) (begin-pt (point-max))) (goto-char begin-pt) (insert (if browse-kill-ring-depropertize (browse-kill-ring-depropertize-string str) str)) (when browse-kill-ring-highlight-inserted-item (let ((o (make-overlay begin-pt (point-max)))) (overlay-put o 'face 'highlight) (sit-for 0.5) (delete-overlay o))) (goto-char pt)))) (set-buffer orig))))) (defun browse-kill-ring-delete () "Remove the item at point from the `kill-ring'." (interactive) (let ((over (car (overlays-at (point))))) (unless (overlayp over) (error "No kill ring item here")) (unwind-protect (progn (setq buffer-read-only nil) (let ((target (overlay-get over 'browse-kill-ring-target))) (delete-region (overlay-start over) (1+ (overlay-end over))) (setq kill-ring (delete target kill-ring))) (when (get-text-property (point) 'browse-kill-ring-extra) (let ((prev (previous-single-property-change (point) 'browse-kill-ring-extra)) (next (next-single-property-change (point) 'browse-kill-ring-extra))) ;; This is some voodoo. (when prev (incf prev)) (when next (incf next)) (delete-region (or prev (point-min)) (or next (point-max)))))) (setq buffer-read-only t))) (browse-kill-ring-resize-window) (browse-kill-ring-forward 0)) (defun browse-kill-ring-current-string (buf pt) (with-current-buffer buf (let ((overs (overlays-at pt))) (or (and overs (overlay-get (car overs) 'browse-kill-ring-target)) (error "No kill ring item here"))))) (defun browse-kill-ring-do-insert (buf pt) (let ((str (browse-kill-ring-current-string buf pt))) (let ((orig (current-buffer))) (unwind-protect (progn (unless (window-live-p browse-kill-ring-original-window) (error "Window %s has been deleted; Try calling `browse-kill-ring' a= gain" browse-kill-ring-original-window)) (set-buffer (window-buffer browse-kill-ring-original-window)) (save-excursion (let ((pt (point))) (insert (if browse-kill-ring-depropertize (browse-kill-ring-depropertize-string str) str)) (when browse-kill-ring-highlight-inserted-item (let ((o (make-overlay pt (point)))) (overlay-put o 'face 'highlight) (sit-for 0.5) (delete-overlay o)))))) (set-buffer orig))))) (defun browse-kill-ring-forward (&optional arg) "Move forward by ARG `kill-ring' entries." (interactive "p") (beginning-of-line) (while (not (zerop arg)) (if (< arg 0) (progn (incf arg) (if (overlays-at (point)) (progn (goto-char (overlay-start (car (overlays-at (point))))) (goto-char (previous-overlay-change (point))) (goto-char (previous-overlay-change (point)))) (progn (goto-char (1- (previous-overlay-change (point)))) (unless (bobp) (goto-char (overlay-start (car (overlays-at (point))))))))) (progn (decf arg) (if (overlays-at (point)) (progn (goto-char (overlay-end (car (overlays-at (point))))) (goto-char (next-overlay-change (point)))) (goto-char (next-overlay-change (point))) (unless (eobp) (goto-char (overlay-start (car (overlays-at (point)))))))))) ;; This could probably be implemented in a more intelligent manner. ;; Perhaps keep track over the overlay we started from? That would ;; break when the user moved manually, though. (when (and browse-kill-ring-highlight-current-entry (overlays-at (point))) (let ((overs (overlay-lists)) (current-overlay (car (overlays-at (point))))) (mapcar #'(lambda (o) (overlay-put o 'face nil)) (nconc (car overs) (cdr overs))) (overlay-put current-overlay 'face 'highlight))) (when browse-kill-ring-recenter (recenter 1))) (defun browse-kill-ring-previous (&optional arg) "Move backward by ARG `kill-ring' entries." (interactive "p") (browse-kill-ring-forward (- arg))) (defun browse-kill-ring-read-regexp (msg) (let* ((default (car regexp-history)) (input (read-from-minibuffer (if default (format "%s for regexp (default `%s'): " msg default) (format "%s (regexp): " msg)) nil nil nil 'regexp-history))) (if (equal input "") default input))) (defun browse-kill-ring-search-forward (regexp &optional backwards) "Move to the next `kill-ring' entry matching REGEXP from point. If optional arg BACKWARDS is non-nil, move to the previous matching entry." (interactive (list (browse-kill-ring-read-regexp "Search forward") current-prefix-arg)) (let ((orig (point))) (browse-kill-ring-forward (if backwards -1 1)) (let ((overs (overlays-at (point)))) (while (and overs (not (if backwards (bobp) (eobp))) (not (string-match regexp (overlay-get (car overs) 'browse-kill-ring-target)))) (browse-kill-ring-forward (if backwards -1 1)) (setq overs (overlays-at (point)))) (unless (and overs (string-match regexp (overlay-get (car overs) 'browse-kill-ring-target))) (progn (goto-char orig) (message "No more `kill-ring' entries matching %s" regexp)))))) (defun browse-kill-ring-search-backward (regexp) "Move to the previous `kill-ring' entry matching REGEXP from point." (interactive (list (browse-kill-ring-read-regexp "Search backward"))) (browse-kill-ring-search-forward regexp t)) (defun browse-kill-ring-quit () "Take the action specified by `browse-kill-ring-quit-action'." (interactive) (case browse-kill-ring-quit-action (save-and-restore (let (buf (current-buffer)) (set-window-configuration browse-kill-ring-original-window-config) (kill-buffer buf))) (kill-and-delete-window (kill-buffer (current-buffer)) (unless (=3D (count-windows) 1) (delete-window))) (bury-and-delete-window (bury-buffer) (unless (=3D (count-windows) 1) (delete-window))) (t (funcall browse-kill-ring-quit-action)))) (put 'browse-kill-ring-mode 'mode-class 'special) (define-derived-mode browse-kill-ring-mode fundamental-mode "Kill Ring" "A major mode for browsing the `kill-ring'. You most likely do not want to call `browse-kill-ring-mode' directly; use `browse-kill-ring' instead. \\{browse-kill-ring-mode-map}" (set (make-local-variable 'font-lock-defaults) '(nil t nil nil nil (font-lock-fontify-region-function . browse-kill-ring-fontify-region)= )) (define-key browse-kill-ring-mode-map (kbd "q") 'browse-kill-ring-quit) (define-key browse-kill-ring-mode-map (kbd "U") 'browse-kill-ring-undo-ot= her-window) (define-key browse-kill-ring-mode-map (kbd "d") 'browse-kill-ring-delete) (define-key browse-kill-ring-mode-map (kbd "s") 'browse-kill-ring-search-= forward) (define-key browse-kill-ring-mode-map (kbd "r") 'browse-kill-ring-search-= backward) (define-key browse-kill-ring-mode-map (kbd "g") 'browse-kill-ring-update) (define-key browse-kill-ring-mode-map (kbd "l") 'browse-kill-ring-occur) (define-key browse-kill-ring-mode-map (kbd "e") 'browse-kill-ring-edit) (define-key browse-kill-ring-mode-map (kbd "n") 'browse-kill-ring-forward) (define-key browse-kill-ring-mode-map (kbd "p") 'browse-kill-ring-previou= s) (define-key browse-kill-ring-mode-map [(mouse-2)] 'browse-kill-ring-mouse= -insert) (define-key browse-kill-ring-mode-map (kbd "?") 'describe-mode) (define-key browse-kill-ring-mode-map (kbd "h") 'describe-mode) (define-key browse-kill-ring-mode-map (kbd "y") 'browse-kill-ring-insert) (define-key browse-kill-ring-mode-map (kbd "u") 'browse-kill-ring-insert-= move-and-quit) (define-key browse-kill-ring-mode-map (kbd "i") 'browse-kill-ring-insert) (define-key browse-kill-ring-mode-map (kbd "o") 'browse-kill-ring-insert-= and-move) (define-key browse-kill-ring-mode-map (kbd "x") 'browse-kill-ring-insert-= and-delete) (define-key browse-kill-ring-mode-map (kbd "RET") 'browse-kill-ring-inser= t-and-quit) (define-key browse-kill-ring-mode-map (kbd "b") 'browse-kill-ring-prepend= -insert) (define-key browse-kill-ring-mode-map (kbd "a") 'browse-kill-ring-append-= insert)) ;;;###autoload (defun browse-kill-ring-default-keybindings () "Set up M-y (`yank-pop') so that it can invoke `browse-kill-ring'. Normally, if M-y was not preceeded by C-y, then it has no useful behavior. This function sets things up so that M-y will invoke `browse-kill-ring'." (interactive) (defadvice yank-pop (around kill-ring-browse-maybe (arg)) "If last action was not a yank, run `browse-kill-ring' instead." ;; yank-pop has an (interactive "*p") form which does not allow ;; it to run in a read-only buffer. We want browse-kill-ring to ;; be allowed to run in a read only buffer, so we change the ;; interactive form here. In that case, we need to ;; barf-if-buffer-read-only if we're going to call yank-pop with ;; ad-do-it (interactive "p") (if (not (eq last-command 'yank)) (browse-kill-ring) (barf-if-buffer-read-only) ad-do-it)) (ad-activate 'yank-pop)) (define-derived-mode browse-kill-ring-edit-mode fundamental-mode "Kill Ring Edit" "A major mode for editing a `kill-ring' entry. You most likely do not want to call `browse-kill-ring-edit-mode' directly; use `browse-kill-ring' instead. \\{browse-kill-ring-edit-mode-map}" (define-key browse-kill-ring-edit-mode-map (kbd "C-c C-c") 'browse-kill-ring-edit-finish)) (defvar browse-kill-ring-edit-target nil) (make-variable-buffer-local 'browse-kill-ring-edit-target) (defun browse-kill-ring-edit () "Edit the `kill-ring' entry at point." (interactive) (let ((overs (overlays-at (point)))) (unless overs (error "No kill ring entry here")) (let* ((target (overlay-get (car overs) 'browse-kill-ring-target)) (target-cell (member target kill-ring))) (unless target-cell (error "Item deleted from the kill-ring")) (switch-to-buffer (get-buffer-create "*Kill Ring Edit*")) (setq buffer-read-only nil) (erase-buffer) (insert target) (goto-char (point-min)) (browse-kill-ring-resize-window) (browse-kill-ring-edit-mode) (message "%s" (substitute-command-keys "Use \\[browse-kill-ring-edit-finish] to finish editing.")) (setq browse-kill-ring-edit-target target-cell)))) (defun browse-kill-ring-edit-finish () "Commit the changes to the `kill-ring'." (interactive) (if browse-kill-ring-edit-target (setcar browse-kill-ring-edit-target (buffer-string)) (when (y-or-n-p "The item has been deleted; add to front? ") (push (buffer-string) kill-ring))) (bury-buffer) ;; The user might have rearranged the windows (when (eq major-mode 'browse-kill-ring-mode) (browse-kill-ring-setup (current-buffer) browse-kill-ring-original-window nil browse-kill-ring-original-window-config) (browse-kill-ring-resize-window))) (defmacro browse-kill-ring-add-overlays-for (item &rest body) (let ((beg (gensym "browse-kill-ring-add-overlays-")) (end (gensym "browse-kill-ring-add-overlays-"))) `(let ((,beg (point)) (,end (progn ,@body (point)))) (let ((o (make-overlay ,beg ,end))) (overlay-put o 'browse-kill-ring-target ,item) (overlay-put o 'mouse-face 'highlight))))) ;; (put 'browse-kill-ring-add-overlays-for 'lisp-indent-function 1) (defun browse-kill-ring-elide (str) (if (and browse-kill-ring-maximum-display-length (> (length str) browse-kill-ring-maximum-display-length)) (concat (substring str 0 (- browse-kill-ring-maximum-display-length 3= )) (browse-kill-ring-propertize "..." 'browse-kill-ring-extra t)) str)) (defun browse-kill-ring-insert-as-one-line (items) (dolist (item items) (browse-kill-ring-add-overlays-for item (let* ((item (browse-kill-ring-elide item)) (len (length item)) (start 0) (newl (browse-kill-ring-propertize "\\n" 'browse-kill-ring-extra t))) (while (and (< start len) (string-match "\n" item start)) (insert (substring item start (match-beginning 0)) newl) (setq start (match-end 0))) (insert (substring item start len)))) (insert "\n"))) (defun browse-kill-ring-insert-as-separated (items) (while (cdr items) (browse-kill-ring-insert-as-separated-1 (car items) t) (setq items (cdr items))) (when items (browse-kill-ring-insert-as-separated-1 (car items) nil))) (defun browse-kill-ring-insert-as-separated-1 (origitem separatep) (let* ((item (browse-kill-ring-elide origitem)) (len (length item))) (browse-kill-ring-add-overlays-for origitem (insert item)) ;; When the kill-ring has items with read-only text property at ;; **the end of** string, browse-kill-ring-setup fails with error ;; `Text is read-only'. So inhibit-read-only here. ;; See http://bugs.debian.org/225082 ;; - INOUE Hiroyuki (let ((inhibit-read-only t)) (insert "\n") (when separatep (insert (browse-kill-ring-propertize browse-kill-ring-separator 'browse-kill-ring-extra t 'browse-kill-ring-separator t)) (insert "\n"))))) (defun browse-kill-ring-occur (regexp) "Display all `kill-ring' entries matching REGEXP." (interactive (list (browse-kill-ring-read-regexp "Display kill ring entries matching"))) (assert (eq major-mode 'browse-kill-ring-mode)) (browse-kill-ring-setup (current-buffer) browse-kill-ring-original-window regexp) (browse-kill-ring-resize-window)) (defun browse-kill-ring-fontify-on-property (prop face beg end) (save-excursion (goto-char beg) (let ((prop-end nil)) (while (setq prop-end (let ((prop-beg (or (and (get-text-property (point) prop) (point)) (next-single-property-change (point) prop nil end)))) (when (and prop-beg (not (=3D prop-beg end))) (let ((prop-end (next-single-property-change prop-beg prop nil end))) (when (and prop-end (not (=3D prop-end end))) (put-text-property prop-beg prop-end 'face face) prop-end))))) (goto-char prop-end))))) (defun browse-kill-ring-fontify-region (beg end &optional verbose) (when verbose (message "Fontifying...")) (let ((buffer-read-only nil)) (browse-kill-ring-fontify-on-property 'browse-kill-ring-extra 'bold beg= end) (browse-kill-ring-fontify-on-property 'browse-kill-ring-separator browse-kill-ring-separator-face beg end)) (when verbose (message "Fontifying...done"))) (defun browse-kill-ring-update () "Update the buffer to reflect outside changes to `kill-ring'." (interactive) (assert (eq major-mode 'browse-kill-ring-mode)) (browse-kill-ring-setup (current-buffer) browse-kill-ring-original-window) (browse-kill-ring-resize-window)) (defun browse-kill-ring-setup (buf window &optional regexp window-config) (with-current-buffer buf (unwind-protect (progn (browse-kill-ring-mode) (setq buffer-read-only nil) (when (eq browse-kill-ring-display-style 'one-line) (setq truncate-lines t)) (let ((inhibit-read-only t)) (erase-buffer)) (setq browse-kill-ring-original-window window browse-kill-ring-original-window-config (or window-config (current-window-configuration))) (let ((browse-kill-ring-maximum-display-length (if (and browse-kill-ring-maximum-display-length (<=3D browse-kill-ring-maximum-display-length 3)) 4 browse-kill-ring-maximum-display-length)) (items (mapcar (if browse-kill-ring-depropertize #'browse-kill-ring-depropertize-string #'copy-sequence) kill-ring))) (when (not browse-kill-ring-display-duplicates) ;; I'm not going to rewrite `delete-duplicates'. If ;; someone really wants to rewrite it here, send me a ;; patch. (require 'cl) (setq items (delete-duplicates items :test #'equal))) (when (stringp regexp) (setq items (delq nil (mapcar #'(lambda (item) (when (string-match regexp item) item)) items)))) (funcall (or (cdr (assq browse-kill-ring-display-style browse-kill-ring-display-styles)) (error "Invalid `browse-kill-ring-display-style': %s" browse-kill-ring-display-style)) items) ;; Code from Michael Slass (message (let ((entry (if (=3D 1 (length kill-ring)) "entry" "entries"))) (concat (if (and (not regexp) browse-kill-ring-display-duplicates) (format "%s %s in the kill ring." (length kill-ring) entry) (format "%s (of %s) %s in the kill ring shown." (length items) (length kill-ring) entry)) (substitute-command-keys (concat " Type \\[browse-kill-ring-quit] to quit. " "\\[describe-mode] for help."))))) ;; End code from Michael Slass (set-buffer-modified-p nil) (goto-char (point-min)) (browse-kill-ring-forward 0) (when regexp (setq mode-name (concat "Kill Ring [" regexp "]"))) (run-hooks 'browse-kill-ring-hook) ;; I will be very glad when I can get rid of this gross ;; hack, which solely exists for XEmacs users. (when (and (featurep 'xemacs) font-lock-mode) (browse-kill-ring-fontify-region (point-min) (point-max))))) (progn (setq buffer-read-only t))))) ;;;###autoload (defun browse-kill-ring () "Display items in the `kill-ring' in another buffer." (interactive) (if (eq major-mode 'browse-kill-ring-mode)=20 (message "Already viewing the kill ring") (let ((orig-buf (current-buffer)) (buf (get-buffer-create "*Kill Ring*"))) (browse-kill-ring-setup buf (selected-window)) (pop-to-buffer buf) (browse-kill-ring-resize-window) nil))) (provide 'browse-kill-ring) ;;; browse-kill-ring.el ends here --=-=-= -- Joakim Verona --=-=-=--