home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / misc / yank-match.el < prev    next >
Encoding:
Text File  |  1993-05-19  |  4.8 KB  |  136 lines
  1. ;;; -*- Mode: Emacs-Lisp -*-
  2. ;;; File: yank-match.el
  3. ;;; 
  4. ;;; Yanks matches for REGEXP from kill-ring.
  5. ;;; Karl Fogel
  6. ;;; (kfogel@cs.oberlin.edu)
  7. ;;;
  8. ;;; This code is distributed under the terms of the GNU General Public
  9. ;;; License. If you are not sure what that means, contact the author.
  10. ;;; If you do not have electronic mail access, write him at
  11. ;;;
  12. ;;; Karl Fogel
  13. ;;; 1123 N. Oak Park Ave.
  14. ;;; Oak Park, ILL
  15. ;;; USA      60302
  16. ;;;
  17. ;;; for more information.
  18. ;;;
  19. ;;; Please let me know what you think of it... I like messages with
  20. ;;; complaints almost as much as ones without complaints! :-)
  21. ;;;
  22. ;;; INSTALLATION:
  23. ;;; Put this stuff into your .emacs file, along with a line like:
  24. ;;; (global-set-key "\C-oy" 'yank-match)
  25. ;;;
  26. ;;; or whatever your preferred key-binding is.
  27. ;;; 
  28. ;;; USAGE:
  29. ;;; Just call yank-match ("M-x yank-match" or whatever key-binding you 
  30. ;;; have intalled for it) and supply a regular expression, and it will 
  31. ;;; yank the first item in the kill ring containing a match for that
  32. ;;; regexp.  (See documentation for the function "yank" for more details.)
  33. ;;;
  34. ;;; Yank match does set point and mark, just like "yank" does.
  35. ;;;
  36. ;;; Repeated yanks cycle through the kill-ring, taking the next match, and 
  37. ;;; the next, and go right back to the beginning and start over, until 
  38. ;;; you break the cycle with some other command.  Yank-match does not 
  39. ;;; normally move yanks to the front of the kill-ring, but see variable
  40. ;;; yank-match-modify-kill-ring to change this behaviour. 
  41. ;;;
  42. ;;;   LCD Archive Entry:
  43. ;;;   yank-match|Karl Fogel|kfogel@cs.oberlin.edu|
  44. ;;;   Yanks match(es) for REGEXP from kill-ring|
  45. ;;;   20-May-1993||~/misc/yank-match.el.el.Z|
  46.  
  47. (defvar yank-match-count 0 "Which match in kill ring yank-match will 
  48. yank.")
  49.  
  50. (defvar yank-match-last-regexp nil "Last regexp used by yank-match.")
  51.  
  52. (defvar yank-match-modify-kill-ring nil "*Non-nil means place matches 
  53. at the front of the kill-ring, thus making it not behave like a ring for
  54. yank-match functions.  Instead you'd \"bounce back\" from one end of
  55. the kill-ring to the other with repeated yank-matches.  However, each
  56. match would then be available for immediate yanking with \\[yank].
  57.  
  58. Unless inefficiency really offends you, you should leave this set to nil.")
  59.  
  60. (defvar yank-match-inserted nil "Did we insert on last yank match?")
  61.  
  62. (defun yank-match (re)
  63.   "Yank out the first item in the kill-ring that contains a match for
  64. REGEXP.  Repeated execution of this command yanks you successively
  65. through the matches in the kill-ring.  Because the kill-ring is a ring
  66. \(or a dead ringer for one, at least\), it is okay for you to repeat
  67. more times than the length of the kill-ring.  It just means that your
  68. mistakes will come back to haunt you.
  69.  
  70. Matches are not put automatically at the front of the kill ring, but
  71. if you do a \\[copy-region-as-kill] or a \\[kill-ring-save]
  72. immediately after finding the match you wanted, it will then be put at
  73. the front of the ring, and \\[yank] will default to that match.
  74.  
  75. See also variable yank-match-modify-kill-ring for a way to make matches
  76. automatically be put at the front of the kill-ring \(and thus be available
  77. for immediate yanking\)."
  78.   (interactive (if (equal last-command 'yank-match)
  79.            (list yank-match-last-regexp)
  80.          (list (read-from-minibuffer "Yank match (regexp): "))))
  81.   (let ((repeating (equal last-command 'yank-match)))
  82.     (if repeating
  83.     (progn
  84.       ;; if inserted on last yank, kill that region before yanking new
  85.       (if yank-match-inserted 
  86.           (progn
  87.         (setq yank-match-inserted nil)
  88.         (delete-region (mark) (point))))
  89.  
  90.       ;; if repeating and successful match this time
  91.       (if (do-yank-match re yank-match-count)
  92.         (setq yank-match-count (1+ yank-match-count))
  93.  
  94.         ;; if repeating and unsuccessful match this time
  95.         (progn
  96.           (setq yank-match-count 1)
  97.           (do-yank-match re 0))))
  98.               
  99.       ;; if not repeating
  100.       (if (do-yank-match re 0)
  101.       (setq yank-match-count 1)
  102.     (error 
  103.      (concat "No match found for \"" re "\" in kill-ring.")))))
  104.   (setq yank-match-last-regexp re)
  105.   (setq this-command 'yank-match))
  106.  
  107.  
  108. (defun do-yank-match (re num)
  109.   ;; if you can stand to read this function, then you should have your head
  110.   ;; examined...
  111.   (let ((found-one t))
  112.     (catch 'done
  113.       (let ((index 0)
  114.         (len (1- (length kill-ring))))
  115.     (progn
  116.       (while (<= index len)
  117.         (let ((str (nth index kill-ring)))
  118.           (if (string-match re str)
  119.           (if (= num 0)
  120.               (progn (setq found-one nil)
  121.                  (setq yank-match-inserted t)
  122.                  (push-mark (point))
  123.                  (insert str)
  124.                  (if yank-match-modify-kill-ring
  125.                  (setq 
  126.                   kill-ring
  127.                   (cons str (delq str kill-ring))))
  128.                  (throw 'done nil))
  129.             (progn (setq found-one t)
  130.                (setq num (1- num))
  131.                (setq index (1+ index))))
  132.         (setq index (1+ index))))))))
  133.     (not found-one))) ; so it returns t on success! 
  134.  
  135. ;;; end yank-match.el ;;;
  136.