# HG changeset patch # User Jim Blandy # Date 708387780 0 # Node ID 7af12ccaa6c180b1deb0f70a0662d8d754b4540f # Parent d105ddc785b82269e61160f098ec22db0aaf5162 *** empty log message *** diff -r d105ddc785b8 -r 7af12ccaa6c1 lisp/simple.el --- a/lisp/simple.el Fri Jun 12 20:56:21 1992 +0000 +++ b/lisp/simple.el Fri Jun 12 22:23:00 1992 +0000 @@ -100,12 +100,14 @@ (save-excursion (beginning-of-line) (setq thisblank (looking-at "[ \t]*$")) + ;; Set singleblank if there is just one blank line here. (setq singleblank (and thisblank (not (looking-at "[ \t]*\n[ \t]*$")) (or (bobp) (progn (forward-line -1) (not (looking-at "[ \t]*$"))))))) + ;; Delete preceding blank lines, and this one too if it's the only one. (if thisblank (progn (beginning-of-line) @@ -114,6 +116,8 @@ (if (re-search-backward "[^ \t\n]" nil t) (progn (forward-line 1) (point)) (point-min))))) + ;; Delete following blank lines, unless the current line is blank + ;; and there are no following blank lines. (if (not (and thisblank singleblank)) (save-excursion (end-of-line) @@ -121,7 +125,11 @@ (delete-region (point) (if (re-search-forward "[^ \t\n]" nil t) (progn (beginning-of-line) (point)) - (point-max))))))) + (point-max))))) + ;; Handle the special case where point is followed by newline and eob. + ;; Delete the line, leaving point at eob. + (if (looking-at "^[ \t]*\n\\'") + (delete-region (point) (point-max))))) (defun back-to-indentation () "Move point to the first non-whitespace character on this line." @@ -235,7 +243,10 @@ (recenter -3))) (defun mark-whole-buffer () - "Put point at beginning and mark at end of buffer." + "Put point at beginning and mark at end of buffer. +You probably should not use this function in Lisp programs; +it is usually a mistake for a Lisp function to use any subroutine +that uses or sets the mark." (interactive) (push-mark (point)) (push-mark (point-max)) @@ -591,12 +602,12 @@ (interactive nil) (let ((factor 4) key) - (describe-arg (list factor) 1) - (setq key (read-key-sequence nil)) +;; (describe-arg (list factor) 1) + (setq key (read-key-sequence nil t)) (while (equal (key-binding key) 'universal-argument) (setq factor (* 4 factor)) - (describe-arg (list factor) 1) - (setq key (read-key-sequence nil))) +;; (describe-arg (list factor) 1) + (setq key (read-key-sequence nil t))) (prefix-arg-internal key factor nil))) (defun prefix-arg-internal (key factor value) @@ -605,19 +616,19 @@ (setq sign -1 value (- value))) (if (eq value '-) (setq sign -1 value nil)) - (describe-arg value sign) +;; (describe-arg value sign) (while (equal key "-") (setq sign (- sign) factor nil) - (describe-arg value sign) - (setq key (read-key-sequence nil))) +;; (describe-arg value sign) + (setq key (read-key-sequence nil t))) (while (and (= (length key) 1) (not (string< key "0")) (not (string< "9" key))) (setq value (+ (* (if (numberp value) value 0) 10) (- (aref key 0) ?0)) factor nil) - (describe-arg value sign) - (setq key (read-key-sequence nil))) +;; (describe-arg value sign) + (setq key (read-key-sequence nil t))) (setq prefix-arg (cond (factor (list factor)) ((numberp value) (* value sign)) @@ -627,7 +638,7 @@ (if (eq (key-binding key) 'universal-argument) (progn (describe-arg value sign) - (setq key (read-key-sequence nil)))) + (setq key (read-key-sequence nil t)))) (if (= (length key) 1) ;; Make sure self-insert-command finds the proper character; ;; unread the character and let the command loop process it. @@ -688,10 +699,46 @@ (end-of-line))) (point)))) -;;;; The kill ring +;;;; Window system cut and paste hooks. + +(defvar interprogram-cut-function nil + "Function to call to make a killed region available to other programs. + +Most window systems provide some sort of facility for cutting and +pasting text between the windows of different programs. On startup, +this variable is set to a function which emacs will call whenever text +is put in the kill ring to make the new kill available to other +programs. + +The function takes one argument, TEXT, which is a string containing +the text which should be made available.") + +(defvar interprogram-paste-function nil + "Function to call to get text cut from other programs. + +Most window systems provide some sort of facility for cutting and +pasting text between the windows of different programs. On startup, +this variable is set to a function which emacs will call to obtain +text that other programs have provided for pasting. + +The function should be called with no arguments. If the function +returns nil, then no other program has provided such text, and the top +of the Emacs kill ring should be used. If the function returns a +string, that string should be put in the kill ring as the latest kill.") + + + +;;;; The kill ring data structure. (defvar kill-ring nil - "List of killed text sequences.") + "List of killed text sequences. +Since the kill ring is supposed to interact nicely with cut-and-paste +facilities offered by window systems, use of this variable should +interact nicely with `interprogram-cut-function' and +`interprogram-paste-function'. The functions `kill-new', +`kill-append', and `current-kill' are supposed to implement this +interaction; you may want to use them instead of manipulating the kill +ring directly.") (defconst kill-ring-max 30 "*Maximum length of kill ring before oldest elements are thrown away.") @@ -699,22 +746,60 @@ (defvar kill-ring-yank-pointer nil "The tail of the kill ring whose car is the last thing yanked.") +(defun kill-new (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." + (setq kill-ring (cons string kill-ring)) + (if (> (length kill-ring) kill-ring-max) + (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)) + (setq kill-ring-yank-pointer kill-ring) + (if interprogram-cut-function + (funcall interprogram-cut-function string))) + (defun kill-append (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." (setcar kill-ring (if before-p (concat string (car kill-ring)) - (concat (car kill-ring) string)))) - -(defvar interprogram-cut-function nil - "Function to call to make a killed region available to other programs. + (concat (car kill-ring) string))) + (if interprogram-cut-function + (funcall interprogram-cut-function (car kill-ring)))) -Most window systems provide some sort of facility for cutting and -pasting text between the windows of different programs. On startup, -this variable is set to a function which emacs will call to make the -most recently killed text available to other programs. +(defun current-kill (n &optional do-not-move) + "Rotate the yanking point by N places, and then return that kill. +If N is zero, `interprogram-paste-function' is set, and calling it +returns a string, then that string is added to the front of the +kill ring and returned as the latest kill. +If optional arg DO-NOT-MOVE is non-nil, then don't actually move the +yanking point; just return the Nth kill forward." + (let ((interprogram-paste (and (= n 0) + interprogram-paste-function + (funcall interprogram-paste-function)))) + (if interprogram-paste + (progn + ;; Disable the interprogram cut function when we add the new + ;; text to the kill ring, so Emacs doesn't try to own the + ;; selection, with identical text. + (let ((interprogram-cut-function nil)) + (kill-new interprogram-paste)) + interprogram-paste) + (or kill-ring (error "Kill ring is empty")) + (let* ((length (length kill-ring)) + (ARGth-kill-element + (nthcdr (% (+ n (- length (length kill-ring-yank-pointer))) + length) + kill-ring))) + (or do-not-move + (setq kill-ring-yank-pointer ARGth-kill-element)) + (car ARGth-kill-element))))) -The function takes one argument, TEXT, which is a string containing -the text which should be made available.") + + +;;;; Commands for manipulating the kill ring. (defun kill-region (beg end) "Kill between point and mark. @@ -730,24 +815,22 @@ the text killed this time appends to the text killed last time to make one entry in the kill ring." (interactive "r") - (if (and (not (eq buffer-undo-list t)) - (not (eq last-command 'kill-region)) - (not (eq beg end)) - (not buffer-read-only)) - ;; Don't let the undo list be truncated before we can even access it. - (let ((undo-high-threshold (+ (- (max beg end) (min beg end)) 100))) - (delete-region beg end) - ;; Take the same string recorded for undo - ;; and put it in the kill-ring. - (setq kill-ring (cons (car (car buffer-undo-list)) kill-ring)) - (if interprogram-cut-function - (funcall interprogram-cut-function (car kill-ring))) - (if (> (length kill-ring) kill-ring-max) - (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)) - (setq this-command 'kill-region) - (setq kill-ring-yank-pointer kill-ring)) + (cond + (buffer-read-only + (copy-region-as-kill beg end)) + ((not (or (eq buffer-undo-list t) + (eq last-command 'kill-region) + (eq beg end))) + ;; Don't let the undo list be truncated before we can even access it. + (let ((undo-high-threshold (+ (- (max beg end) (min beg end)) 100))) + (delete-region beg end) + ;; Take the same string recorded for undo + ;; and put it in the kill-ring. + (kill-new (car (car buffer-undo-list))) + (setq this-command 'kill-region))) + (t (copy-region-as-kill beg end) - (or buffer-read-only (delete-region beg end)))) + (delete-region beg end)))) (defun copy-region-as-kill (beg end) "Save the region as if killed, but don't kill it. @@ -756,21 +839,28 @@ (interactive "r") (if (eq last-command 'kill-region) (kill-append (buffer-substring beg end) (< end beg)) - (setq kill-ring (cons (buffer-substring beg end) kill-ring)) - (if (> (length kill-ring) kill-ring-max) - (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil))) - (if interprogram-cut-function - (funcall interprogram-cut-function (car kill-ring))) - (setq this-command 'kill-region - kill-ring-yank-pointer kill-ring) + (kill-new (buffer-substring beg end))) + (setq this-command 'kill-region) nil) (defun kill-ring-save (beg end) "Save the region as if killed, but don't kill it." (interactive "r") (copy-region-as-kill beg end) - (message "%d characters copied to kill ring" - (- (max beg end) (min beg end)))) + (save-excursion + (let ((other-end (if (= (point) beg) end beg))) + (if (pos-visible-in-window-p other-end (selected-window)) + (progn + (goto-char other-end) + (sit-for 1)) + (let* ((killed-text (current-kill 0)) + (message-len (min (length killed-text) 40))) + (message + (if (= (point) beg) + (format "Killed until \"%s\"" + (substring killed-text (- message-len))) + (format "Killed from \"%s\"" + (substring killed-text 0 message-len))))))))) (defun append-next-kill () "Cause following command, if kill, to append to previous kill." @@ -781,17 +871,6 @@ (message "If the next command is a kill, it will append")) (setq last-command 'kill-region))) -(defun rotate-yank-pointer (arg) - "Rotate the yanking point in the kill ring." - (interactive "p") - (let ((length (length kill-ring))) - (if (zerop length) - (error "Kill ring is empty") - (setq kill-ring-yank-pointer - (nthcdr (% (+ arg (- length (length kill-ring-yank-pointer))) - length) - kill-ring))))) - (defun yank-pop (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. @@ -811,9 +890,8 @@ (setq this-command 'yank) (let ((before (< (point) (mark)))) (delete-region (point) (mark)) - (rotate-yank-pointer arg) (set-mark (point)) - (insert (car kill-ring-yank-pointer)) + (insert (current-kill arg)) (if before (exchange-point-and-mark)))) (defun yank (&optional arg) @@ -825,13 +903,20 @@ text. See also the command \\[yank-pop]." (interactive "*P") - (rotate-yank-pointer (if (listp arg) 0 - (if (eq arg '-) -1 - (1- arg)))) (push-mark (point)) - (insert (car kill-ring-yank-pointer)) + (insert (current-kill (cond + ((listp arg) 0) + ((eq arg '-) -1) + (t (1- arg))))) (if (consp arg) (exchange-point-and-mark))) + +(defun rotate-yank-pointer (arg) + "Rotate the yanking point in the kill ring. +With argument, rotate that many kills forward (or backward, if negative)." + (interactive "p") + (current-kill arg)) + (defun insert-buffer (buffer) "Insert after point the contents of BUFFER. @@ -856,7 +941,8 @@ When calling from a program, give three arguments: BUFFER (or buffer name), START and END. START and END specify the portion of the current buffer to be copied." - (interactive "BAppend to buffer: \nr") + (interactive + (list (read-buffer "Append to buffer: " (other-buffer nil t) t))) (let ((oldbuf (current-buffer))) (save-excursion (set-buffer (get-buffer-create buffer))