home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 5 Edit
/
05-Edit.zip
/
me34exe.zip
/
mutt
/
package
/
killring.mut
< prev
next >
Wrap
Lisp/Scheme
|
1995-01-14
|
6KB
|
219 lines
;; Basic editing commands for Emacs
;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
;; This file was a part of GNU Emacs: simple.el
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY. No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing. Refer to the GNU Emacs General Public
;; License for full details.
;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License. A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities. It should be in a
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;;; The kill ring
(include me.mh)
;; Notes:
;; I use bags (instead of strings) to hold the text in the kill ring
;; because (concat) chokes with long strings. Even if I fixed
;; (concat), I probably couldn't for MS-DOS. Besides, using bags
;; probably makes the routines a little bit faster.
(list kill-ring) ;; "List of killed text sequences."
;; "*Maximum length of kill ring before oldest elements are thrown away."
(small-int max-in-ring)
(defun
MAIN { (kill-ring-max 10) }
kill-ring-max
{
(if (!= 0 (nargs)) (max-in-ring (arg 0)))
max-in-ring
}
)
;; "The tail of the kill ring whose car is the last thing yanked.")
(small-int kill-ring-yank-pointer)
(defun
clear-kill-ring
{
(int i n)
(n (length-of kill-ring))
(for (i 0) (< i n) (+= i 1) (free-bag (extract-element kill-ring i)))
(remove-elements kill-ring 0 10000)
(kill-ring-yank-pointer 0)
}
)
(defun kill-append (int mark1 mark2) (bool prepend)
{
(int bag)
(bag (extract-element kill-ring 0))
(if prepend
(prepend-to-bag bag APPEND-REGION mark1 mark2)
(append-to-bag bag APPEND-REGION mark1 mark2))
})
;; Kill between point and mark.
;; The text is deleted but saved in the kill ring.
;; The command \\[yank] can retrieve it from there.
;; \(If you want to kill and then yank immediately, use \\[copy-region-as-kill].)
;; This is the primitive for programs to kill text (as opposed to deleting it).
;; Supply two arguments, character numbers indicating the stretch of text
;; to be killed.
;; Any command that calls this function is a \"kill command\".
;; If the previous command was also a kill command,
;; the text killed this time appends to the text killed last time
;; to make one entry in the kill ring.
(defun kill-region
{
; (interactive "*r")
(cut-save-hook THE-DOT THE-MARK FALSE)
(delete-region)
})
;;!!!(fset 'kill-ring-save 'copy-region-as-kill)
(defun
cut-save-hook (int mark1 mark2) (bool prepend)
{
(int bag n)
(if (command-flag CMDFLG-TEST CF-CUT)
(kill-append mark1 mark2 prepend)
{
(append-to-bag (bag (create-bag TRUE)) APPEND-REGION mark1 mark2)
(insert-object kill-ring -1 bag)
(if (> (length-of kill-ring) (kill-ring-max))
{
(n (- (length-of kill-ring) 1))
(free-bag (extract-element kill-ring n))
(remove-elements kill-ring n 1)
})
})
(command-flag CMDFLG-SET CF-CUT)
(kill-ring-yank-pointer 0)
}
)
;; "Save the region as if killed, but don't kill it."
(defun copy-region-as-kill
{
(if (not (mark-valid THE-MARK))
{ (msg "Need to set the mark!") FALSE (done) })
(cut-save-hook THE-DOT THE-MARK FALSE)
TRUE
})
;; "Cause following command, if kill, to append to previous kill."
(defun append-next-kill
{
(command-flag CMDFLG-SET CF-CUT)
})
(defun modulo (int n base) { (- n (* (/ n base) base)) })
;; "Rotate the yanking point in the kill ring."
(defun rotate-yank-pointer HIDDEN
{
(int length n)
(length (length-of kill-ring))
(if (== 0 length) { (msg "Kill ring is empty") FALSE (done) })
(n (arg-prefix))
(arg-flag FALSE 1) ;; reset arg count
(kill-ring-yank-pointer (modulo (+ n kill-ring-yank-pointer) length))
(if (< kill-ring-yank-pointer 0) (+= kill-ring-yank-pointer length))
(if (< kill-ring-yank-pointer 0) { (msg "rotate-yank-pointer: Negative arg!") })
})
;; "Replace just-yanked stretch of killed-text with a different stretch.
;; This command is allowed only immediately after a yank or a yank-pop.
;; At such a time, the region contains a stretch of reinserted
;; previously-killed text. yank-pop deletes that text and inserts in its
;; place a different stretch of killed text.
;; With no argument, the previous kill is inserted.
;; With argument n, the n'th previous kill is inserted.
;; If n is negative, this is a more recent kill.
;; The sequence of kills wraps around, so that after the oldest one
;; comes the newest one."
(defun yank-pop
{
(bool before)
(byte type)(small-int left-edge width height)(int size) ;; RegionInfo
(if (command-flag CMDFLG-NTEST CF-YANK)
{ (msg "Previous command was not a yank") FALSE (done) })
(command-flag CMDFLG-SET CF-YANK)
(region-stats (loc type))
(before (== type DOT-ABOVE-MARK))
(delete-region)
(rotate-yank-pointer)
(set-mark THE-MARK)
(insert-bag (extract-element kill-ring kill-ring-yank-pointer))
(if before (swap-marks))
})
;; "Reinsert the last stretch of killed text.
;; More precisely, reinsert the stretch of killed text most recently
;; killed OR yanked.
;; With just C-U as argument, same but put point in front (and mark at end).
;; With argument n, reinsert the nth most recently killed stretch of killed
;; text.
;; See also the command \\[yank-pop]."
(defun yank ;(&optional arg)
{
; (interactive "*P")
(bool before)
(if (== 0 (length-of kill-ring)) (done))
(before FALSE)
(if (and (arg-flag) (universal-argument-no-key))
{ (arg-prefix 0) (before TRUE) }
(arg-prefix (- (arg-prefix) 1)))
(rotate-yank-pointer)
(set-mark)
(insert-bag (extract-element kill-ring kill-ring-yank-pointer))
(if before (swap-marks))
(command-flag CMDFLG-SET CF-YANK)
})
(defun MAIN
{
(bind-key GLOBAL-KEYMAP
"kill-region" "C-w"
"copy-region-as-kill" "M-w"
"append-next-kill" "M-C-w"
"yank" "C-y"
"yank-pop" "M-y"
)
})