Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

945 lines (834 sloc) 31.849 kb
;;; Time-stamp: <2006-05-29 14:57:02 john>
;;;; yank-menu.el
;;; Inspired by browse-yank.el -- this package pops up a menu
;;; containing the contents of the kill ring, with one entry per line.
;;; Multi-line entries are displayed with \n or similar syntax
;;; (user-selectable).
(require 'electric)
(require 'cl)
(provide 'yank-menu)
;; todo: Generate the buffer lazily, ie only as far as is visible and then generate more as it is scrolled
;; todo: appending to the current kill to update buffer accordingly in the frame-of-its-own mode
;; todo: adding kills to maintain grepalike flags for new entries?
;; todo: automatic (switchable) bring-to-top of items you refer to?
;; todo: fix putting items into general last-search-string
;; todo: jotter function
;; todo: bring-to-top of existing kills
;
;;;; Hooks and customization
;
(defvar yank-menu-entry-hooks nil
"Entry hook list for electric-yank-menu.")
(defvar yank-menu-exit-hooks nil
"Exit hook list for electric-yank-menu.")
(defvar yank-menu-collection-separator " "
"*Separator to go between items collected by yank-menu-mark-item-for-insertion.")
(defvar yank-menu-buffer-name "*Kill ring*"
"*Name of the yank menu buffer.")
(defvar yank-menu-buffer nil
"The yank menu buffer.")
(defvar yank-menu-try-to-keep-unique t
"Whether to remove an identical string from further down the kill ring
before putting the new one in.")
(defvar yank-menu-newline-representation "\\n"
"*String to represent newlines by in electric-yank-menu.")
(defvar yank-menu-remember-last-inserted-buffer t
"Whether to remember which buffer we last inserted something into,
from the separate kill-ring-window form of activity. Otherwise try to
work out which buffer the user was previous using.")
;
;;;; Internal state variables
;
(defvar yank-menu-item-number 0
"The currently selected item number in the yank menu.")
(defvar yank-menu-max-item 0
"The maximum possible item number in the yank menu
counting from 0.")
(defvar yank-menu-displaying-full nil
"*Whether to display the current item in full.")
(defvar yank-menu-above nil
"List of items above the current one, backwards.")
(defvar yank-menu-below nil
"List of items below the current one, forwards.")
(defvar yank-menu-current (car kill-ring)
"The current item.")
(defun yank-menu-below (cdr kill-ring)
"List of items below the current one, forwards.")
(defvar yank-menu-last-search-pattern ""
"The current yank menu search string.")
(defvar yank-menu-active nil
"Flag to say whether we are in yank menu.")
(defvar yank-menu-additional-insertions nil
"Things to insert other than the final selection.")
(defvar yank-menu-additional-insertions-count 0
"Count of things to insert other than the final selection.
FYI only.")
(defvar yank-menu-deledendi nil
"List of things to be deleted on completing this yank-menu command loop.")
(defvar yank-menu-last-inserted-buffer nil
"Buffer we have most recently stuck things into.")
(defvar yank-menu-last-prepared-list nil
"Cache last prepared list to avoid re-preparing menu buffer
when no kills have been added since the last time.")
(make-local-variable 'yank-menu-last-prepared-list)
(defvar yank-menu-total-bytes 0
"How many bytes are stored in the whole kill ring.
FYI only.")
(defvar yank-menu-remembered-place 0
"A remembered place, for doing something like exchange-point-and-mark.")
(defvar yank-menu-original-kill-new (symbol-function 'kill-new)
"Save the original value of kill-new.")
(fset 'yank-menu-original-kill-new yank-menu-original-kill-new)
(defadvice kill-new (before yank-menu () activate)
(if yank-menu-try-to-keep-unique
(yank-menu-remove-equal-entry string)))
(defadvice kill-new (after yank-menu () activate)
"Update the yank-menu frame if needed"
(if (and (boundp 'yank-menu-frame) (framep yank-menu-frame))
(progn ;; save-excursion ;; why did I do save-excursion here?
(set-buffer yank-menu-buffer)
;; to do: make sure that this ends up at the top of the buffer!
(yank-menu-prepare-buffer kill-ring)
(save-window-excursion
;; we need to save the window excursion because the item
;; expansion otherwise comes up in the frame you do the
;; deletion from as well as the kill ring frame
;; (let ((old-frame (selected-frame)))
;; (select-frame yank-menu-frame)
(yank-menu-display-current)
;; (select-frame old-frame)
;; )
)
;; I'm trying to get it to go to the top! I know it's in the right buffer at this point, I made it print that out!
;; see bug-example.el
(yank-menu-top))))
(defun kill-new2 (string)
"Make STRING the latest kill in the kill ring.
Set the kill-ring-yank pointer to point to it.
If `interprogram-cut-function' is non-nil, apply it to STRING."
(save-excursion
(save-window-excursion
(if (not (and yank-menu-try-to-keep-unique
(string= string (car kill-ring))))
(progn
(if yank-menu-try-to-keep-unique
(yank-menu-remove-equal-entry string))
(yank-menu-original-kill-new string)
(if (and (boundp 'yank-menu-frame) (framep yank-menu-frame))
(progn;; save-excursion ;; why did I do save-excursion here?
(set-buffer yank-menu-buffer)
;; to do: make sure that this ends up at the top of the buffer!
(yank-menu-prepare-buffer kill-ring)
(save-window-excursion
;; we need to save the window excursion because the item
;; expansion otherwise comes up in the frame you do the
;; deletion from as well as the kill ring frame
;; (let ((old-frame (selected-frame)))
;; (select-frame yank-menu-frame)
(yank-menu-display-current)
;; (select-frame old-frame)
;; )
)
;; I'm trying to get it to go to the top! I know it's in the right buffer at this point, I made it print that out!
;; see bug-example.el
(yank-menu-top))))))))
;; todo: replace this by "advice"
(defvar yank-menu-original-kill-append (symbol-function 'kill-append)
"Save the original value of kill-append.")
(fset 'yank-menu-original-kill-append yank-menu-original-kill-append)
(defadvice kill-append (after yank-menu () activate)
(save-window-excursion
(save-excursion
(set-buffer yank-menu-buffer)
(yank-menu-top)
;; to do: make this update the main kill-ring buffer as well as
;; the expansion one; probably make it do this by hacking
;; the last entry out if its view of the latest prepared
;; item and also removing the top line of the buffer, and
;; letting it re-do it as though it were a new one... be
;; careful about the numbering too!
(setq yank-menu-current (car kill-ring))
(save-window-excursion
(yank-menu-display-current)))))
(defun kill-append2 (string before-p)
"Append STRING to the end of the latest kill in the kill ring.
If BEFORE-P is non-nil, prepend STRING to the kill.
If `interprogram-cut-function' is set, pass the resulting kill to
it."
(yank-menu-original-kill-append string before-p)
(save-window-excursion
(save-excursion
(set-buffer yank-menu-buffer)
(yank-menu-top)
;; to do: make this update the main kill-ring buffer as well as
;; the expansion one; probably make it do this by hacking
;; the last entry out if its view of the latest prepared
;; item and also removing the top line of the buffer, and
;; letting it re-do it as though it were a new one... be
;; careful about the numbering too!
(setq yank-menu-current (car kill-ring))
(save-window-excursion
(yank-menu-display-current)))))
;;;###autoload
(defun yank-menu-frame-start ()
"Run a yank menu in a frame of its own."
(interactive)
(let ((made-new-buffer nil))
(run-hooks 'yank-menu-entry-hooks)
(setq yank-menu-max-item (1- (length kill-ring))
yank-menu-additional-insertions nil
yank-menu-additional-insertions-count 0
yank-menu-deledendi nil
yank-menu-total-bytes (apply '+ (mapcar 'length kill-ring)))
(yank-menu-top)
(or yank-menu-buffer
(setq yank-menu-buffer (get-buffer-create yank-menu-buffer-name)
made-new-buffer t))
(set-buffer yank-menu-buffer)
(if made-new-buffer (kill-all-local-variables))
(setq truncate-lines t
Helper-return-blurb "return to yank menu"
mode-name "Yank Menu"
mode-line-buffer-identification "Yank List")
(buffer-enable-undo yank-menu-buffer)
(use-local-map yank-menu-map)
(yank-menu-prepare-buffer kill-ring)
(yank-menu-display-current)
(require 'yank-menu-frame)
(select-frame (yank-menu-get-frame))))
;
;;;; Keymap
;
(defvar yank-menu-map (make-keymap)
"Key map for yank menus.")
(if (arrayp yank-menu-map)
(fillarray yank-menu-map 'yank-menu-undefined)
(if (arrayp (car yank-menu-map))
(fillarray (car yank-menu-map) 'yank-menu-undefined)))
(suppress-keymap yank-menu-map)
(define-key yank-menu-map " " 'yank-menu-insert)
(define-key yank-menu-map "i" 'yank-menu-insert)
(define-key yank-menu-map "I" 'yank-menu-insert-numbered-item)
(define-key yank-menu-map "q" 'yank-menu-quit)
(define-key yank-menu-map "m" 'yank-menu-mark-item-for-insertion)
(define-key yank-menu-map "n" 'yank-menu-next)
(define-key yank-menu-map [down] 'yank-menu-next)
(define-key yank-menu-map "\r" 'yank-menu-next)
(define-key yank-menu-map "p" 'yank-menu-previous)
(define-key yank-menu-map [up] 'yank-menu-previous)
(define-key yank-menu-map "" 'yank-menu-previous)
(define-key yank-menu-map "<" 'yank-menu-top)
(define-key yank-menu-map [home] 'yank-menu-top)
(define-key yank-menu-map ">" 'yank-menu-bottom)
(define-key yank-menu-map [end] 'yank-menu-bottom)
(define-key yank-menu-map "j" 'yank-menu-jump-to-item)
(define-key yank-menu-map "g" 'yank-menu-jump-to-item)
(define-key yank-menu-map "s" 'yank-menu-search-forward)
(define-key yank-menu-map "S" 'yank-menu-search-forward)
(define-key yank-menu-map "\C-s" 'yank-menu-search-forward)
(define-key yank-menu-map "r" 'yank-menu-search-backward)
(define-key yank-menu-map "R" 'yank-menu-search-backward)
(define-key yank-menu-map "\C-r" 'yank-menu-search-backward)
(define-key yank-menu-map "" 'yank-menu-remember-place)
(define-key yank-menu-map "x" 'yank-menu-exchange-place)
(define-key yank-menu-map "\e" (make-keymap))
(define-key yank-menu-map "\C-v" 'yank-menu-next-screen)
(define-key yank-menu-map [next] 'yank-menu-next-screen)
(define-key yank-menu-map "\ev" 'yank-menu-previous-screen)
(define-key yank-menu-map [prior] 'yank-menu-previous-screen)
(define-key yank-menu-map "c" 'yank-menu-count)
(define-key yank-menu-map "?" 'Helper-describe-bindings)
(define-key yank-menu-map "^" 'yank-menu-to-top)
(define-key yank-menu-map "*" 'yank-menu-expand-item)
(define-key yank-menu-map "t" 'yank-menu-toggle-full-display)
(define-key yank-menu-map "g" 'yank-menu-greppalike)
(define-key yank-menu-map "d" 'yank-menu-delete)
(define-key yank-menu-map "u" 'yank-menu-unmark)
(define-key yank-menu-map "a" 'yank-menu-append-to-buffer-after-point)
(define-key yank-menu-map "b" 'yank-menu-append-to-buffer-before-point)
(define-key yank-menu-map "w" 'yank-menu-current-to-string-search)
(define-key yank-menu-map "W" 'yank-menu-current-to-regexp-search)
;; (define-key yank-menu-map [left] 'yank-menu-undefined)
;; (define-key yank-menu-map [right] 'yank-menu-undefined)
;
;;;; Commands
;
;;;###autoload
(defun yank-menu-undefined ()
"Do nothing in the yank menu buffer."
(interactive)
(ding)
(message "Not a valid yank-menu command"))
(defun yank-menu-insert ()
"Exit yank menu, inserting current item."
(interactive)
(throw 'yank-menu-quit (cons t yank-menu-item-number)))
(defun yank-menu-quit ()
"Exit yank menu, not doing anything."
(interactive)
(if yank-menu-active
(throw 'yank-menu-quit (cons nil nil))
(progn
;; This is for safety. It's really horrible if you get into
;; the yank-menu buffer while not running electric-yank-menu!
(bury-buffer)
(switch-to-buffer (other-buffer nil)))))
(defun yank-menu-mark-item-for-insertion ()
"Add the current item to a list of things to be inserted."
(interactive)
(delete-char 1)
(insert "m")
(setq yank-menu-additional-insertions
(cons yank-menu-current yank-menu-additional-insertions)
yank-menu-additional-insertions-count
(1+ yank-menu-additional-insertions-count))
yank-menu-current)
(defun yank-menu-next ()
"Go to the next yank menu entry."
(interactive)
(if yank-menu-below
(progn
(setq yank-menu-item-number (1+ yank-menu-item-number)
yank-menu-above (cons yank-menu-current yank-menu-above)
yank-menu-current (car yank-menu-below)
yank-menu-below (cdr yank-menu-below))
(beginning-of-line 2)))
(if (interactive-p) (yank-menu-display-current))
yank-menu-current)
(defun yank-menu-previous ()
"Go to the previous yank menu entry."
(interactive)
(if yank-menu-above
(progn
(setq yank-menu-item-number (1- yank-menu-item-number)
yank-menu-below (cons yank-menu-current yank-menu-below)
yank-menu-current (car yank-menu-above)
yank-menu-above (cdr yank-menu-above))
(beginning-of-line 0)))
(if (interactive-p) (yank-menu-display-current))
yank-menu-current)
(defun yank-menu-next-screen ()
"Go down a screenful or so."
(interactive)
(let ((i (- (window-height) 4)))
(while (and (> i 0) yank-menu-current)
(setq i (1- i))
(yank-menu-next)))
(yank-menu-display-current))
(defun yank-menu-previous-screen ()
"Go up a screenful or so."
(interactive)
(let ((i (- (window-height) 4)))
(while (and (> i 0) yank-menu-current)
(setq i (1- i))
(yank-menu-previous)))
(yank-menu-display-current))
(defun yank-menu-top ()
"Go to the top yank menu entry."
(interactive)
(goto-char (point-min))
(setq yank-menu-item-number 0
yank-menu-above nil
yank-menu-current (car kill-ring)
yank-menu-below (cdr kill-ring))
(if (interactive-p)
(yank-menu-display-current))
yank-menu-current)
(defun yank-menu-bottom ()
"Go to the top yank menu entry."
(interactive)
(goto-char (point-max))
(beginning-of-line 0)
(setq yank-menu-item-number yank-menu-max-item
yank-menu-above (reverse kill-ring)
yank-menu-current (car yank-menu-above)
yank-menu-above (cdr yank-menu-above)
yank-menu-below nil)
(yank-menu-display-current)
yank-menu-current)
(defun yank-menu-search-forward ()
"Search forward for PATTERN in the yank menu.
If called from yank-menu, varies its behaviour according to the
character typed to invoke it, thus:
s prompts for pattern, offering previous one as default
S prompts for pattern, offering no default
\\C-s uses previous pattern without prompting."
(interactive)
(if (not (= last-command-char ?\C-s))
(progn
(setq yank-menu-last-search-pattern
(read-from-minibuffer "Search forward for (regexp): "
(if (= last-command-char ?S)
nil
yank-menu-last-search-pattern)
nil
nil))
(yank-menu-remove-old-grep-marks)))
(yank-menu-next)
(while (and yank-menu-below
(not (string-match yank-menu-last-search-pattern
yank-menu-current
nil)))
(yank-menu-next))
(if (not yank-menu-below)
(message "No more [%s] found going down" yank-menu-last-search-pattern))
(yank-menu-display-current)
yank-menu-current)
(defun yank-menu-search-backward ()
"Search backward for PATTERN in the yank menu.
If called from yank-menu, varies its behaviour according to the
character typed to invoke it, thus:
r prompts for pattern, offering previous one as default
R prompts for pattern, offering no default
\\C-r uses previous pattern without prompting."
(interactive)
(if (not (= last-command-char ?\C-r))
(progn
(setq yank-menu-last-search-pattern
(read-from-minibuffer "Search backward for (regexp): "
(if (= last-command-char ?R)
nil
yank-menu-last-search-pattern)
nil
nil))
(yank-menu-remove-old-grep-marks)))
(yank-menu-previous)
(while (and yank-menu-above
(not (string-match yank-menu-last-search-pattern
yank-menu-current
nil)))
(yank-menu-previous))
(if (not yank-menu-above)
(message "No more [%s] found going up" yank-menu-last-search-pattern))
(yank-menu-display-current)
yank-menu-current)
(defun yank-menu-to-top ()
"Move the current item to the top of the yank menu."
(interactive)
(if yank-menu-below
(save-excursion
(let* ((start (point))
(end (progn (beginning-of-line 2) (point)))
(presentation-string (buffer-substring start end))
(k kill-ring))
(while (and k (not (eq (car (cdr k)) yank-menu-current)))
(setq k (cdr k)))
(if (and k (cdr k)) (rplacd k (cdr (cdr k))))
(delete-region start end)
(goto-char (point-min))
(insert presentation-string)
(setq kill-ring (cons yank-menu-current kill-ring)
yank-menu-above (nreverse yank-menu-above)
yank-menu-above (cons yank-menu-current yank-menu-above)
yank-menu-above (nreverse yank-menu-above)
yank-menu-below (cdr yank-menu-below))
(yank-menu-display-current)))))
(defun yank-menu-jump-to-item (n)
"Jump to an item specified by number."
(interactive "NJump to item number: ")
(cond
((< yank-menu-item-number n)
(while (< yank-menu-item-number n)
(yank-menu-next)))
((> yank-menu-item-number n)
(while (> yank-menu-item-number n)
(yank-menu-previous)))
((< n 0)
(error "Item number is before start of list"))
((> n yank-menu-max-item)
(error "Item number is beyond end of list"))
((= n yank-menu-item-number)
(message "Already there"))
(t (message "huh")))
(if (interactive-p) (yank-menu-display-current)))
(defun yank-menu-insert-numbered-item (n)
"Insert an item specified by number."
(interactive "NInsert item number: ")
(yank-menu-jump-to-item n)
(yank-menu-insert))
(defun yank-menu-remember-place ()
"Remember the current place, for \\[yank-menu-exchange-place] command."
(interactive)
(setq yank-menu-remembered-place yank-menu-item-number))
(defun yank-menu-exchange-place ()
"Exchange this position and the rememebered one."
(interactive)
(let ((old-place yank-menu-item-number))
(yank-menu-jump-to-item yank-menu-remembered-place)
(setq yank-menu-remembered-place old-place))
(yank-menu-display-current))
(defun yank-menu-select-buffer (prompt)
"Choose a buffer to which to append items."
(setq yank-menu-last-inserted-buffer
(read-buffer prompt
(if yank-menu-remember-last-inserted-buffer
yank-menu-last-inserted-buffer
(window-buffer (frame-selected-window (next-frame))))
t)))
(defun yank-menu-append-to-buffer-before-point (buffer)
"Append the current item to BUFFER at its point and move that point."
(interactive (list (yank-menu-select-buffer
"Append before point in buffer: ")))
(set-buffer buffer)
(yank-menu-really-do-insertion yank-menu-current))
(defun yank-menu-append-to-buffer-after-point (buffer)
"Append the current item to BUFFER at its point and do not move that point."
(interactive (list (yank-menu-select-buffer
"Append after point in buffer: ")))
(set-buffer buffer)
(save-excursion
(insert yank-menu-current)))
(defun yank-menu-expand-item ()
"Display the current item in full."
(interactive)
(with-output-to-temp-buffer
"*Current yank item*"
(princ yank-menu-current)))
(defun yank-menu-toggle-full-display ()
"Toggle whether to display the current item in full."
(interactive)
(setq yank-menu-displaying-full (not yank-menu-displaying-full))
(if yank-menu-displaying-full
(yank-menu-expand-item)
(delete-other-windows nil)))
(defun yank-menu-display-current ()
"Display the current item in full if full display enabled."
(if yank-menu-displaying-full
(yank-menu-expand-item)))
(defun yank-menu-count ()
"Show the number of items matching the current search pattern."
(interactive)
(setq yank-menu-last-search-pattern
(read-from-minibuffer "Count items matching (regexp): "
yank-menu-last-search-pattern
nil
nil))
(yank-menu-remove-old-grep-marks)
(let ((k kill-ring)
(n 0))
(while k
(if (string-match yank-menu-last-search-pattern
(car k) nil)
(setq n (1+ n)))
(setq k (cdr k)))
(message "%d items match %s" n yank-menu-last-search-pattern)
(sit-for 10)))
(defvar yank-menu-current-grepmark-pattern nil
"The current grep-marked pattern.
Used to avoid unnecessary removal of grep marks.")
(defun yank-menu-remove-old-grep-marks ()
"Remove all the marks made by yank-menu-greppalike.
This should be done whenever the search pattern changes."
(if (not (string= yank-menu-current-grepmark-pattern
yank-menu-last-search-pattern))
(save-excursion
(goto-char (point-min))
(replace-regexp "^ >" " " nil))))
(defun yank-menu-greppalike ()
"Indicate which items match the current search pattern."
(interactive)
(setq yank-menu-last-search-pattern
(read-from-minibuffer "Indicate items matching (regexp): "
yank-menu-last-search-pattern
nil
nil))
(yank-menu-remove-old-grep-marks)
(setq yank-menu-current-grepmark-pattern
yank-menu-last-search-pattern)
(save-excursion
(goto-char (point-min))
(let ((k kill-ring))
(while k
(if (string-match yank-menu-last-search-pattern
(car k) nil)
(progn
(forward-char 1)
(delete-char 1)
(insert ">")))
(beginning-of-line 2)
(setq k (cdr k))))))
(defun yank-menu-delete ()
"Mark the current item for deletion from the kill ring."
(interactive)
(if (memq yank-menu-current yank-menu-additional-insertions)
(error "Cannot mark item for deletion if it is marked for insertion"))
(setq yank-menu-deledendi (cons yank-menu-current
yank-menu-deledendi))
(delete-char 1)
(insert "d"))
(defun yank-menu-unmark ()
"Remove deletion or insertion marks from the current item."
(interactive)
(setq yank-menu-deledendi
(delq yank-menu-current
yank-menu-deledendi))
(if (memq yank-menu-current
yank-menu-additional-insertions)
(setq yank-menu-additional-insertions
(delq yank-menu-current
yank-menu-additional-insertions)
yank-menu-additional-insertions-count
(1- yank-menu-additional-insertions-count)))
(delete-char 1)
(insert " "))
;
;;;; interact with emacs search facilities
;
(defun yank-menu-current-to-string-search ()
"Make the current yank menu item become the current emacs search string."
(interactive)
(setq-default search-last-string yank-menu-current)
(message "Search string is now %s" search-last-string))
(defun yank-menu-current-to-regexp-search ()
"Make the current yank menu item become the current emacs search regexp."
(interactive)
(setq-default search-last-regexp yank-menu-current)
(message "Search regexp is now %s" search-last-regexp))
;
;;;; presenting the kill ring in a buffer
;
(defvar yank-menu-descr-regexp "^.. *[0-9]+ "
"Pattern for recognizing yank menu line headers.")
(defun yank-menu-prepare-buffer (items)
"Prepare a yank menu buffer for ITEMS in the current buffer."
(if (not (eq yank-menu-last-prepared-list items))
(let* ((n (length items))
(ym-hack-marker (make-marker))
(descr-format (format " %% %dd "
(length
(int-to-string n))))
(new-last-prepared-list items)
(i 0))
(message "Preparing yank menu buffer...")
(goto-char (point-min))
(while (and items (not (eq items yank-menu-last-prepared-list)))
(let ((end-of-insertion (save-excursion
(insert (format descr-format i)
(car items))
(set-marker ym-hack-marker (point)))))
(message "Preparing yank menu buffer... %d" i)
(setq i (1+ i))
(while (and (not (eobp))
(search-forward "\n" end-of-insertion t))
(delete-char -1)
(insert-before-markers yank-menu-newline-representation))
(goto-char end-of-insertion)
(insert "\n"))
(setq items (cdr items)))
;; now carry on down the buffer, rewriting numbers
(while (<= i n)
(if (re-search-forward yank-menu-descr-regexp (point-max) t)
(progn
(delete-region (match-beginning 0) (match-end 0))
(insert (format descr-format i))
(end-of-line 1))
(setq i (1+ n)))
;; (message "Renumbering remaining lines... %d" i)
(setq i (1+ i)))
;; and finally trim off old stuff from the bottom
(delete-region (point) (point-max))
(message "Preparing yank menu buffer... done")
(set-marker ym-hack-marker nil)
(setq yank-menu-last-prepared-list new-last-prepared-list))
(if yank-menu-last-prepared-list
(progn
(yank-menu-remove-old-grep-marks)
(goto-char (point-min))
(replace-regexp "^m" " " nil))))
(yank-menu-top))
(defun yank-menu-remove-equal-entry (string)
"Remove an entry that is equal to STRING."
(if yank-menu-last-prepared-list
(save-window-excursion
(set-buffer yank-menu-buffer)
(save-excursion
(goto-char (point-min))
(beginning-of-line 2)
(let* ((this yank-menu-last-prepared-list)
(next (cdr this)))
(while this
(if (string= string (cadr this))
(progn
(setq next (cdr next))
(setcdr this next)
(let* ((line-start (point))
(line-end (progn (beginning-of-line 2)
(point))))
(delete-region line-start line-end)))
(progn
(let ((old-line (point)))
(beginning-of-line 2))))
(setq this next
next (cdr next)))))))
(setq yank-menu-above (delete-if-string= string yank-menu-above)
yank-menu-below (delete-if-string= string yank-menu-below)
kill-ring (delete-if-string= string kill-ring)))
;
;;;; misc bits
;
(defun member-string= (item list)
"Look for ITEM in LIST; return first link in LIST whose car is `string=' to ITEM."
(catch 'found
(while list
(if (string= item (car list))
(throw 'found list))
(setq list (cdr list)))
nil))
(defun cadr-member-string= (item list)
"Look for ITEM in LIST; return first link in LIST whose cadr is `string=' to ITEM."
(let ((prev list))
(setq list (cdr prev))
(catch 'found
(while list
(if (string= item (car list))
(throw 'found prev))
(setq prev list
list (cdr list)))
nil)))
(defun string-list-uniquify (orig)
"Return a copy of ORIG with duplicates removed.
Each element appears only where it first appeared in ORIG.
Comparison is done with string=."
(let ((result nil))
(while orig
(let ((this (car orig)))
(if (not (member-string= this result))
(setq result (cons this result))))
(setq orig (cdr orig)))
(nreverse result)))
(defun delete-if-memq (a b)
"Remove any memqers of A from B, returning the result."
(while (and b (memq (car b) a))
(setq b (cdr b)))
(let* ((here b) ; initial "here" guaranteed not in a
there)
(while here
(setq there (cdr here))
(while (and there (memq (car there) a))
(setq there (cdr there)))
(rplacd here there)
(setq here (cdr here))))
b)
(defun delete-if-string= (string list)
"Remove string= occurrences of STRING from LIST"
(delete-if (function (lambda (a) (string= a string)))
list))
(defun kill-ring-defontify ()
"Strip the font stuff out of the kill-ring."
(let ((kr kill-ring))
(while kr
(let ((entry (car kr)))
(set-text-properties 0 (length entry)
nil entry)
(rplaca kr (identity entry)))
(setq kr (cdr kr)))))
;
;;;; Command loop
;
(defun yank-menu-make-prompt ()
"Make the current prompt string."
(let ((contains (and yank-menu-current
(string-match yank-menu-last-search-pattern
yank-menu-current
nil))))
(format "search %c%s%c; %sitem %d(%d bytes)/%d(%d bytes): %s"
(if contains ?{ ?[)
yank-menu-last-search-pattern
(if contains ?} ?])
(if yank-menu-additional-insertions (format "(collecting %d) " yank-menu-additional-insertions-count) "")
yank-menu-item-number
(length yank-menu-current)
yank-menu-max-item
yank-menu-total-bytes
yank-menu-current)))
(defvar yank-menu-edit-before-insertion t
"*Whether to do a recursive-edit before inserting each thing.")
(defun yank-menu-really-do-insertion (insertendum)
"Insert INSERTENDUM, possibly allowing the user to modify it first,
according to yank-menu-edit-before-insertion."
(if yank-menu-edit-before-insertion
(save-window-excursion
(let ((insertion-edit-buffer (get-buffer-create "*edit insertion*")))
(switch-to-buffer-other-window insertion-edit-buffer)
(set-buffer insertion-edit-buffer)
(erase-buffer)
(insert insertendum)
(message (substitute-command-keys "Edit insertion; \\[exit-recursive-edit] to insert"))
(save-window-excursion
(recursive-edit))
(set-buffer insertion-edit-buffer)
(setq insertendum (buffer-string))
;; (message "Got %s" insertendum) (sit-for 2)
(bury-buffer))))
(insert-before-markers insertendum))
;;;###autoload
(defun electric-yank-menu (&optional uniquify)
"Select an item from the kill ring using a menu buffer.
Items containing more than one line are converted to a single line
by replacing each newline with the string in
yank-menu-newline-representation (qv).
With prefix arg UNIQUIFY, discard duplicate entries.
Commands available are
\\{yank-menu-map}
"
(interactive "P")
(if (and (boundp 'yank-menu-frame) (framep yank-menu-frame))
(error "Yank menu is already running in its own frame -- use that instead")
(progn
;; (kill-ring-defontify)
(if uniquify
(let ((old-length (length kill-ring)))
(message "Discarding duplicates...")
(setq kill-ring (string-list-uniquify kill-ring))
(message "Discarded %d duplicates" (- old-length (length kill-ring)))))
(let ((todo nil))
(save-excursion
(save-window-excursion
(run-hooks 'yank-menu-entry-hooks)
(setq yank-menu-max-item (1- (length kill-ring))
yank-menu-additional-insertions nil
yank-menu-additional-insertions-count 0
yank-menu-deledendi nil
yank-menu-total-bytes (apply '+ (mapcar 'length kill-ring)))
(yank-menu-top)
(unwind-protect
(progn
(setq yank-menu-active t)
(setq todo
(catch 'yank-menu-quit
(save-window-excursion
(setq yank-menu-buffer (get-buffer-create yank-menu-buffer-name))
(set-buffer yank-menu-buffer)
(kill-all-local-variables)
(setq truncate-lines t
Helper-return-blurb "return to yank menu"
mode-name "Yank Menu"
mode-line-buffer-identification "Yank List")
(buffer-enable-undo yank-menu-buffer)
(use-local-map yank-menu-map)
(yank-menu-prepare-buffer kill-ring)
(yank-menu-display-current)
(Electric-pop-up-window yank-menu-buffer-name)
(let ((Helper-return-blurb "return to yank menu"))
(Electric-command-loop 'yank-menu-quit
'yank-menu-make-prompt
t))))))
(setq yank-menu-active nil)
(bury-buffer yank-menu-buffer))
(run-hooks 'yank-menu-exit-hooks)))
(message "")
(if (and (consp todo) (car todo))
(progn
(if yank-menu-additional-insertions
(yank-menu-really-do-insertion
(mapconcat 'identity
(nreverse yank-menu-additional-insertions)
(setq yank-menu-collection-separator
(read-from-minibuffer "Separator for collected items: "
yank-menu-collection-separator
nil nil)))))
(yank-menu-really-do-insertion yank-menu-current)
(if yank-menu-deledendi
(setq kill-ring (delete-if-memq yank-menu-deledendi kill-ring)
yank-menu-last-prepared-list 'deletions))))))))
;;; end of yank-menu.el
Jump to Line
Something went wrong with that request. Please try again.