home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / me34exe.zip / mutt / package / killring.mut < prev    next >
Lisp/Scheme  |  1995-01-14  |  6KB  |  219 lines
  1. ;; Basic editing commands for Emacs
  2. ;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
  3.  
  4. ;; This file was a part of GNU Emacs: simple.el
  5.  
  6. ;; GNU Emacs is distributed in the hope that it will be useful,
  7. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  8. ;; accepts responsibility to anyone for the consequences of using it
  9. ;; or for whether it serves any particular purpose or works at all,
  10. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  11. ;; License for full details.
  12.  
  13. ;; Everyone is granted permission to copy, modify and redistribute
  14. ;; GNU Emacs, but only under the conditions described in the
  15. ;; GNU Emacs General Public License.   A copy of this license is
  16. ;; supposed to have been given to you along with GNU Emacs so you
  17. ;; can know your rights and responsibilities.  It should be in a
  18. ;; file named COPYING.  Among other things, the copyright notice
  19. ;; and this notice must be preserved on all copies.
  20.  
  21. ;;;; The kill ring
  22.  
  23. (include me.mh)
  24.  
  25.     ;; Notes:
  26.     ;;   I use bags (instead of strings) to hold the text in the kill ring
  27.     ;;     because (concat) chokes with long strings.  Even if I fixed
  28.     ;;     (concat), I probably couldn't for MS-DOS.  Besides, using bags
  29.     ;;     probably makes the routines a little bit faster.
  30.  
  31.  
  32. (list kill-ring)    ;; "List of killed text sequences."
  33.  
  34.     ;; "*Maximum length of kill ring before oldest elements are thrown away."
  35. (small-int max-in-ring)
  36. (defun
  37.   MAIN { (kill-ring-max 10) }
  38.   kill-ring-max
  39.   {
  40.     (if (!= 0 (nargs)) (max-in-ring (arg 0)))
  41.     max-in-ring
  42.   }
  43. )
  44.  
  45.     ;; "The tail of the kill ring whose car is the last thing yanked.")
  46. (small-int kill-ring-yank-pointer)
  47.  
  48. (defun
  49.   clear-kill-ring
  50.   {
  51.     (int i n)
  52.  
  53.     (n (length-of kill-ring))
  54.     (for (i 0) (< i n) (+= i 1) (free-bag (extract-element kill-ring i)))
  55.     (remove-elements kill-ring 0 10000)
  56.     (kill-ring-yank-pointer 0)
  57.   }
  58. )
  59.  
  60. (defun kill-append (int mark1 mark2) (bool prepend)
  61. {
  62.   (int bag)
  63.  
  64.   (bag (extract-element kill-ring 0))
  65.   (if prepend
  66.     (prepend-to-bag bag APPEND-REGION mark1 mark2)
  67.     (append-to-bag  bag APPEND-REGION mark1 mark2))
  68. })
  69.  
  70. ;; Kill between point and mark.
  71. ;; The text is deleted but saved in the kill ring.
  72. ;; The command \\[yank] can retrieve it from there.
  73. ;; \(If you want to kill and then yank immediately, use \\[copy-region-as-kill].)
  74.  
  75. ;; This is the primitive for programs to kill text (as opposed to deleting it).
  76. ;; Supply two arguments, character numbers indicating the stretch of text
  77. ;;  to be killed.
  78. ;; Any command that calls this function is a \"kill command\".
  79. ;; If the previous command was also a kill command,
  80. ;; the text killed this time appends to the text killed last time
  81. ;; to make one entry in the kill ring.
  82.  
  83. (defun kill-region
  84. {
  85. ;  (interactive "*r")
  86.   (cut-save-hook THE-DOT THE-MARK FALSE)
  87.   (delete-region)
  88. })
  89.  
  90. ;;!!!(fset 'kill-ring-save 'copy-region-as-kill)
  91.  
  92. (defun
  93.   cut-save-hook (int mark1 mark2) (bool prepend)
  94.   {
  95.     (int bag n)
  96.  
  97.     (if (command-flag CMDFLG-TEST CF-CUT)
  98.       (kill-append mark1 mark2 prepend)
  99.       {
  100.     (append-to-bag (bag (create-bag TRUE)) APPEND-REGION mark1 mark2)
  101.     (insert-object kill-ring -1 bag)
  102.  
  103.     (if (> (length-of kill-ring) (kill-ring-max))
  104.       {
  105.         (n (- (length-of kill-ring) 1))
  106.         (free-bag (extract-element kill-ring n))
  107.         (remove-elements kill-ring n 1)
  108.       })
  109.       })
  110.     (command-flag CMDFLG-SET CF-CUT)
  111.     (kill-ring-yank-pointer 0)
  112.   }
  113. )
  114.  
  115.     ;; "Save the region as if killed, but don't kill it."
  116. (defun copy-region-as-kill
  117. {
  118.   (if (not (mark-valid THE-MARK))
  119.     { (msg "Need to set the mark!") FALSE (done) })
  120.  
  121.   (cut-save-hook THE-DOT THE-MARK FALSE)
  122.   TRUE
  123. })
  124.  
  125.     ;; "Cause following command, if kill, to append to previous kill."
  126. (defun append-next-kill
  127. {
  128.   (command-flag CMDFLG-SET CF-CUT)
  129. })
  130.  
  131. (defun modulo (int n base) { (- n (* (/ n base) base)) })
  132.  
  133.     ;; "Rotate the yanking point in the kill ring."
  134. (defun rotate-yank-pointer HIDDEN
  135. {
  136.   (int length n)
  137.  
  138.   (length (length-of kill-ring))
  139.   (if (== 0 length) { (msg "Kill ring is empty") FALSE (done) })
  140.   
  141.   (n (arg-prefix))
  142.   (arg-flag FALSE 1)        ;; reset arg count
  143.  
  144.   (kill-ring-yank-pointer (modulo (+ n kill-ring-yank-pointer) length))
  145.   (if (< kill-ring-yank-pointer 0) (+= kill-ring-yank-pointer length))
  146. (if (< kill-ring-yank-pointer 0) { (msg "rotate-yank-pointer: Negative arg!") })
  147. })
  148.  
  149. ;;   "Replace just-yanked stretch of killed-text with a different stretch.
  150. ;; This command is allowed only immediately after a  yank  or a  yank-pop.
  151. ;; At such a time, the region contains a stretch of reinserted
  152. ;; previously-killed text.  yank-pop  deletes that text and inserts in its
  153. ;; place a different stretch of killed text.
  154.  
  155. ;; With no argument, the previous kill is inserted.
  156. ;; With argument n, the n'th previous kill is inserted.
  157. ;; If n is negative, this is a more recent kill.
  158.  
  159. ;; The sequence of kills wraps around, so that after the oldest one
  160. ;; comes the newest one."
  161. (defun yank-pop
  162. {
  163.   (bool before)
  164.   (byte type)(small-int left-edge width height)(int size)    ;; RegionInfo
  165.  
  166.   (if (command-flag CMDFLG-NTEST CF-YANK)
  167.     { (msg "Previous command was not a yank") FALSE (done) })
  168.  
  169.   (command-flag CMDFLG-SET CF-YANK)
  170.  
  171.   (region-stats (loc type))
  172.   (before (== type DOT-ABOVE-MARK))
  173.   (delete-region)
  174.   (rotate-yank-pointer)
  175.   (set-mark THE-MARK)
  176.   (insert-bag (extract-element kill-ring kill-ring-yank-pointer))
  177.   (if before (swap-marks))
  178. })
  179.  
  180. ;;   "Reinsert the last stretch of killed text.
  181. ;; More precisely, reinsert the stretch of killed text most recently
  182. ;; killed OR yanked.
  183. ;; With just C-U as argument, same but put point in front (and mark at end).
  184. ;; With argument n, reinsert the nth most recently killed stretch of killed
  185. ;; text.
  186. ;; See also the command \\[yank-pop]."
  187. (defun yank ;(&optional arg)
  188. {
  189. ;  (interactive "*P")
  190.  
  191.   (bool before)
  192.  
  193.   (if (== 0 (length-of kill-ring)) (done))
  194.  
  195.   (before FALSE)
  196.   (if (and (arg-flag) (universal-argument-no-key))
  197.     { (arg-prefix 0) (before TRUE) }
  198.     (arg-prefix (- (arg-prefix) 1)))
  199.   (rotate-yank-pointer)
  200.  
  201.   (set-mark)
  202.   (insert-bag (extract-element kill-ring kill-ring-yank-pointer))
  203.   (if before (swap-marks))
  204.   (command-flag CMDFLG-SET CF-YANK)
  205. })
  206.  
  207.  
  208.  
  209. (defun MAIN
  210. {
  211.   (bind-key GLOBAL-KEYMAP
  212.     "kill-region"            "C-w"
  213.     "copy-region-as-kill"        "M-w"
  214.     "append-next-kill"        "M-C-w"
  215.     "yank"                "C-y"
  216.     "yank-pop"            "M-y"
  217.   )
  218. })
  219.