;;; -*- Mode: Emacs-Lisp -*-
;;; File: yank-match.el
;;; 
;;; Yanks matches for REGEXP from kill-ring.
;;; Copyright (C) 1997 Karl Fogel <kfogel@red-bean.com>
;;; 
;;; 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 of the License, 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; if not, write to the Free Software Foundation, Inc.,
;;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
;;;
;;; USAGE:
;;;
;;; Just call yank-match ("M-x yank-match" or whatever keybinding you 
;;; have installed for it) and supply a regular expression at the prompt.
;;; See documentation for `yank-match' for more details.

(defvar yank-match-modify-kill-ring nil "*Non-nil means place matches 
at the front of the kill-ring, thus making it not behave like a ring for
yank-match functions.  Instead you'd \"bounce back\" from one end of
the kill-ring to the other with repeated yank-matches.  However, each
match would then be available for immediate yanking with \\[yank].

If that was at all confusing, just leave this set to nil.")

(defvar yank-match-count 0 "Which match in kill ring yank-match will 
yank.")

(defvar yank-match-last-regexp nil "Last regexp used by yank-match.")

(defvar yank-match-inserted nil "Did we insert on last yank match?")

(defun yank-match (re)
  "Yank the first item in the kill-ring that contains a match for RE
\(a regular expression\).  Set point and mark just as \\[yank] does.

Repeated invocations with no intervening commands will run
successively through the matches for RE in the kill-ring,
replacing the previously-yanked text with the new match each
time, without prompting for a new regular expression,

See variable `yank-match-modify-kill-ring' for a way to make matches
automatically be put at the front of the kill-ring \(and thus be available
for immediate yanking\).  Normally, matches are not put at the front
of the kill ring, but if you do \\[copy-region-as-kill] or
\\[kill-ring-save] immediately after finding the match you wanted, it
will then be put at the front of the ring, and \\[yank] will default
to that match.

Because the kill-ring is a ring \(or a dead ringer for one, at
least\), it is okay to repeat this command more times than the number
of matches in the kill-ring.  It just means that previous matches will
come back to haunt you."
  (interactive (if (equal last-command 'yank-match)
		   (list yank-match-last-regexp)
		 (list (read-from-minibuffer "Yank match (regexp): "))))
  (let ((repeating (equal last-command 'yank-match)))
    (if repeating
	(progn
	  ;; if inserted on last yank, kill that region before yanking new
	  (if yank-match-inserted 
	      (progn
		(setq yank-match-inserted nil)
		(delete-region (mark) (point))))

	  ;; if repeating and successful match this time
	  (if (do-yank-match re yank-match-count)
		(setq yank-match-count (1+ yank-match-count))

	    ;; if repeating and unsuccessful match this time
	    (progn
	      (setq yank-match-count 1)
	      (do-yank-match re 0))))
		      
      ;; if not repeating
      (if (do-yank-match re 0)
	  (setq yank-match-count 1)
	(error "No match found for `%s' in kill ring." re))))
  (setq yank-match-last-regexp re)
  (setq this-command 'yank-match))


(defun do-yank-match (re num)
  (let ((found-one t))
    (catch 'done
      (let ((index 0)
	    (len (1- (length kill-ring))))
	(progn
	  (while (<= index len)
	    (let ((str (nth index kill-ring)))
	      (if (string-match re str)
		  (if (= num 0)
		      (progn (setq found-one nil)
			     (setq yank-match-inserted t)
			     (push-mark (point))
			     (insert str)
			     (if yank-match-modify-kill-ring
				 (setq 
				  kill-ring
				  (cons str (delq str kill-ring))))
			     (throw 'done nil))
		    (progn (setq found-one t)
			   (setq num (1- num))
			   (setq index (1+ index))))
		(setq index (1+ index))))))))
    (not found-one))) ; so it returns t on success! 

;;; yank-match.el ends here