;;; simple.el --- basic editing commands for Emacs
-;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 99, 2000, 2001, 2002
+;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 99,
+;; 2000, 2001, 2002, 2003
;; Free Software Foundation, Inc.
;; Maintainer: FSF
text-property `hard'.
With ARG, insert that many newlines.
Call `auto-fill-function' if the current column number is greater
-than the value of `fill-column' and ARG is `nil'."
+than the value of `fill-column' and ARG is nil."
(interactive "*P")
(barf-if-buffer-read-only)
;; Inserting a newline at the end of a line produces better redisplay in
(goto-char loc)
(end-of-line)))
-(defun split-line ()
- "Split current line, moving portion beyond point vertically down."
- (interactive "*")
+(defun split-line (&optional arg)
+ "Split current line, moving portion beyond point vertically down.
+If the current line starts with `fill-prefix', insert it on the new
+line as well. With prefix arg, don't insert fill-prefix on new line.
+
+When called from Lisp code, the arg may be a prefix string to copy."
+ (interactive "*P")
(skip-chars-forward " \t")
- (let ((col (current-column))
- (pos (point)))
+ (let* ((col (current-column))
+ (pos (point))
+ ;; What prefix should we check for (nil means don't).
+ (prefix (cond ((stringp arg) arg)
+ (arg nil)
+ (t fill-prefix)))
+ ;; Does this line start with it?
+ (have-prfx (and prefix
+ (save-excursion
+ (beginning-of-line)
+ (looking-at (regexp-quote prefix))))))
(newline 1)
+ (if have-prfx (insert-and-inherit prefix))
(indent-to col 0)
(goto-char pos)))
digits are interpreted as a character code. This is intended to be
useful for editing binary files."
(interactive "*p")
- (let ((char (if (or (not overwrite-mode)
- (eq overwrite-mode 'overwrite-mode-binary))
- (read-quoted-char)
- (read-char))))
+ (let* ((char (let (translation-table-for-input)
+ (if (or (not overwrite-mode)
+ (eq overwrite-mode 'overwrite-mode-binary))
+ (read-quoted-char)
+ (read-char)))))
;; Assume character codes 0240 - 0377 stand for characters in some
;; single-byte character set, and convert them to Emacs
;; characters.
"Move point to the first non-whitespace character on this line."
(interactive)
(beginning-of-line 1)
- (skip-chars-forward " \t"))
+ (skip-syntax-forward " " (line-end-position))
+ ;; Move back over chars that have whitespace syntax but have the p flag.
+ (backward-prefix-chars))
(defun fixup-whitespace ()
"Fixup white space between objects around point.
(or (equal newcmd (car command-history))
(setq command-history (cons newcmd command-history)))
(eval newcmd))
- (ding))))
+ (if command-history
+ (error "Argument %d is beyond length of command history" arg)
+ (error "There are no previous complex commands to repeat")))))
\f
(defvar minibuffer-history nil
"Default minibuffer history list.
;Put this on C-x u, so we can force that rather than C-_ into startup msg
(defalias 'advertised-undo 'undo)
+(defconst undo-equiv-table (make-hash-table :test 'eq :weakness t)
+ "Table mapping redo records to the corresponding undo one.")
+
+(defvar undo-in-region nil
+ "Non-nil if `pending-undo-list' is not just a tail of `buffer-undo-list'.")
+
+(defvar undo-no-redo nil
+ "If t, `undo' doesn't go through redo entries.")
+
(defun undo (&optional arg)
"Undo some previous changes.
Repeat this command to undo more changes.
A numeric argument serves as a repeat count.
In Transient Mark mode when the mark is active, only undo changes within
-the current region. Similarly, when not in Transient Mark mode, just C-u
+the current region. Similarly, when not in Transient Mark mode, just \\[universal-argument]
as an argument limits undo to changes within the current region."
(interactive "*P")
;; Make last-command indicate for the next command that this was an undo.
(setq this-command 'undo)
(let ((modified (buffer-modified-p))
(recent-save (recent-auto-save-p)))
- (or (eq (selected-window) (minibuffer-window))
- (message (if (and transient-mark-mode mark-active)
- "Undo in region!"
- "Undo!")))
(unless (eq last-command 'undo)
- (if (if transient-mark-mode mark-active (and arg (not (numberp arg))))
+ (setq undo-in-region
+ (if transient-mark-mode mark-active (and arg (not (numberp arg)))))
+ (if undo-in-region
(undo-start (region-beginning) (region-end))
(undo-start))
;; get rid of initial undo boundary
(undo-more 1))
+ ;; Check to see whether we're hitting a redo record, and if
+ ;; so, ask the user whether she wants to skip the redo/undo pair.
+ (let ((equiv (gethash pending-undo-list undo-equiv-table)))
+ (or (eq (selected-window) (minibuffer-window))
+ (message (if undo-in-region
+ (if equiv "Redo in region!" "Undo in region!")
+ (if equiv "Redo!" "Undo!"))))
+ (when (and equiv undo-no-redo)
+ ;; The equiv entry might point to another redo record if we have done
+ ;; undo-redo-undo-redo-... so skip to the very last equiv.
+ (while (let ((next (gethash equiv undo-equiv-table)))
+ (if next (setq equiv next))))
+ (setq pending-undo-list equiv)))
(undo-more
(if (or transient-mark-mode (numberp arg))
(prefix-numeric-value arg)
1))
+ ;; Record the fact that the just-generated undo records come from an
+ ;; undo operation, so we can skip them later on.
+ ;; I don't know how to do that in the undo-in-region case.
+ (unless undo-in-region
+ (puthash buffer-undo-list pending-undo-list undo-equiv-table))
;; Don't specify a position in the undo record for the undo command.
;; Instead, undoing this should move point to where the change is.
(let ((tail buffer-undo-list)
(while (car tail)
(when (integerp (car tail))
(let ((pos (car tail)))
- (if (null prev)
- (setq buffer-undo-list (cdr tail))
- (setcdr prev (cdr tail)))
+ (if prev
+ (setcdr prev (cdr tail))
+ (setq buffer-undo-list (cdr tail)))
(setq tail (cdr tail))
(while (car tail)
(if (eq pos (car tail))
(and modified (not (buffer-modified-p))
(delete-auto-save-file-if-necessary recent-save))))
+(defun undo-only (&optional arg)
+ "Undo some previous changes.
+Repeat this command to undo more changes.
+A numeric argument serves as a repeat count.
+Contrary to `undo', this will not redo a previous undo."
+ (interactive "*p")
+ (let ((undo-no-redo t)) (undo arg)))
+;; Richard said that we should not use C-x <uppercase letter> and I have
+;; no idea whereas to bind it. Any suggestion welcome. -stef
+;; (define-key ctl-x-map "U" 'undo-only)
+
(defvar pending-undo-list nil
"Within a run of consecutive undo commands, list remaining to be undone.")
Call `undo-start' to get ready to undo recent changes,
then call `undo-more' one or more times to undo them."
(or pending-undo-list
- (error (format "No further undo information%s"
- (if (and transient-mark-mode mark-active)
+ (error (format "No further undo information%s"
+ (if (and transient-mark-mode mark-active)
" for region" ""))))
(let ((undo-in-progress t))
(setq pending-undo-list (primitive-undo count pending-undo-list))))
(if (yes-or-no-p "A command is running. Kill it? ")
(kill-process proc)
(error "Shell command in progress")))
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(setq buffer-read-only nil)
(erase-buffer)
(display-buffer buffer)
nil shell-command-switch command)))
;; Report the output.
(with-current-buffer buffer
- (setq mode-line-process
+ (setq mode-line-process
(cond ((null exit-status)
" - Error")
((stringp exit-status)
(defvar kill-ring-yank-pointer nil
"The tail of the kill ring whose car is the last thing yanked.")
-(defun kill-new (string &optional replace)
+(defun kill-new (string &optional replace yank-handler)
"Make STRING the latest kill in the kill ring.
Set `kill-ring-yank-pointer' to point to it.
If `interprogram-cut-function' is non-nil, apply it to STRING.
Optional second argument REPLACE non-nil means that STRING will replace
-the front of the kill ring, rather than being added to the list."
- (and (fboundp 'menu-bar-update-yank-menu)
- (menu-bar-update-yank-menu string (and replace (car kill-ring))))
+the front of the kill ring, rather than being added to the list.
+
+Optional third arguments YANK-HANDLER controls how the STRING is later
+inserted into a buffer; see `insert-for-yank' for details.
+When a yank handler is specified, STRING must be non-empty (the yank
+handler is stored as a `yank-handler'text property on STRING).
+
+When the yank handler has a non-nil PARAM element, the original STRING
+argument is not used by `insert-for-yank'. However, since Lisp code
+may access and use elements from the kill-ring directly, the STRING
+argument should still be a \"useful\" string for such uses."
+ (if (> (length string) 0)
+ (if yank-handler
+ (put-text-property 0 1 'yank-handler yank-handler string)
+ (remove-list-of-text-properties 0 1 '(yank-handler) string))
+ (if yank-handler
+ (signal 'args-out-of-range
+ (list string "yank-handler specified for empty string"))))
+ (if (fboundp 'menu-bar-update-yank-menu)
+ (menu-bar-update-yank-menu string (and replace (car kill-ring))))
(if (and replace kill-ring)
(setcar kill-ring string)
(setq kill-ring (cons string kill-ring))
(if interprogram-cut-function
(funcall interprogram-cut-function string (not replace))))
-(defun kill-append (string before-p)
+(defun kill-append (string before-p &optional yank-handler)
"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."
- (kill-new (if before-p
- (concat string (car kill-ring))
- (concat (car kill-ring) string))
- t))
+Optional third argument YANK-HANDLER specifies the yank-handler text
+property to be set on the combined kill ring string. If the specified
+yank-handler arg differs from the yank-handler property of the latest
+kill string, STRING is added as a new kill ring element instead of
+being appending to the last kill.
+If `interprogram-cut-function' is set, pass the resulting kill to it."
+ (let* ((cur (car kill-ring)))
+ (kill-new (if before-p (concat string cur) (concat cur string))
+ (or (= (length cur) 0)
+ (equal yank-handler (get-text-property 0 'yank-handler cur)))
+ yank-handler)))
(defun current-kill (n &optional do-not-move)
"Rotate the yanking point by N places, and then return that kill.
'(text-read-only buffer-read-only error))
(put 'text-read-only 'error-message "Text is read-only")
-(defun kill-region (beg end)
+(defun kill-region (beg end &optional yank-handler)
"Kill between point and mark.
The text is deleted but saved in the kill ring.
The command \\[yank] can retrieve it from there.
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."
+to make one entry in the kill ring.
+
+In Lisp code, optional third arg YANK-HANDLER specifies the yank-handler
+text property to be set on the killed text. See `insert-for-yank'."
(interactive "r")
(condition-case nil
(let ((string (delete-and-extract-region beg end)))
(when string ;STRING is nil if BEG = END
;; Add that string to the kill ring, one way or another.
(if (eq last-command 'kill-region)
- (kill-append string (< end beg))
- (kill-new string)))
+ (kill-append string (< end beg) yank-handler)
+ (kill-new string nil yank-handler)))
(setq this-command 'kill-region))
((buffer-read-only text-read-only)
;; The code above failed because the buffer, or some of the characters
;; This is actually used in subr.el but defcustom does not work there.
(defcustom yank-excluded-properties
- '(read-only invisible intangible field mouse-face help-echo local-map keymap)
+ '(read-only invisible intangible field mouse-face help-echo local-map keymap
+ yank-handler)
"*Text properties to discard when yanking."
:type '(choice (const :tag "All" t) (repeat symbol))
:group 'editing
:version "21.4")
+(defvar yank-window-start nil)
+(defvar yank-undo-function nil
+ "If non-nil, function used by `yank-pop' to delete last stretch of yanked text.
+Function is called with two parameters, START and END corresponding to
+the value of the mark and point; it is guaranteed that START <= END.
+Normally set from the UNDO element of a yank-handler; see `insert-for-yank'.")
+
(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'.
(setq this-command 'yank)
(let ((inhibit-read-only t)
(before (< (point) (mark t))))
- (delete-region (point) (mark t))
+ (if before
+ (funcall (or yank-undo-function 'delete-region) (point) (mark t))
+ (funcall (or yank-undo-function 'delete-region) (mark t) (point)))
+ (setq yank-undo-function nil)
(set-marker (mark-marker) (point) (current-buffer))
(insert-for-yank (current-kill arg))
+ ;; Set the window start back where it was in the yank command,
+ ;; if possible.
+ (set-window-start (selected-window) yank-window-start t)
(if before
;; This is like exchange-point-and-mark, but doesn't activate the mark.
;; It is cleaner to avoid activation, even though the command
text.
See also the command \\[yank-pop]."
(interactive "*P")
+ (setq yank-window-start (window-start))
;; If we don't get all the way thru, make last-command indicate that
;; for the following command.
(setq this-command t)
(goto-char (prog1 (mark t)
(set-marker (mark-marker) (point) (current-buffer)))))
;; If we do get all the way thru, make this-command indicate that.
- (setq this-command 'yank)
+ (if (eq this-command t)
+ (setq this-command 'yank))
nil)
(defun rotate-yank-pointer (arg)
(let ((col (current-column)))
(forward-char -1)
(setq col (- col (current-column)))
- (insert-char ?\ col)
+ (insert-char ?\ col)
(delete-char 1)))
(forward-char -1)
(setq count (1- count))))))
If the buffer is read-only, Emacs will beep and refrain from deleting
the line, but put the line in the kill ring anyway. This means that
-you can use this command to copy text from a read-only buffer."
+you can use this command to copy text from a read-only buffer.
+\(If the variable `kill-read-only-ok' is non-nil, then this won't
+even beep.)"
(interactive "P")
(kill-region (point)
;; It is better to move point to the other end of the kill
(goto-char end))))
(point))))
+(defun kill-whole-line (&optional arg)
+ "Kill current line.
+With prefix arg, kill that many lines from point.
+If arg is negative, kill backwards.
+If arg is zero, kill current line but exclude the trailing newline."
+ (interactive "P")
+ (setq arg (prefix-numeric-value arg))
+ (cond ((zerop arg)
+ (kill-region (point) (progn (forward-visible-line 0) (point)))
+ (kill-region (point) (progn (end-of-visible-line) (point))))
+ ((< arg 0)
+ (kill-line 1)
+ (kill-line (1+ arg))
+ (unless (bobp) (forward-visible-line -1)))
+ (t
+ (kill-line 0)
+ (if (eobp)
+ (signal 'end-of-buffer nil)
+ (kill-line arg)))))
(defun forward-visible-line (arg)
"Move forward by ARG lines, ignoring currently invisible newlines only.
BUFFER may be a buffer or a buffer name.
This function is meant for the user to run interactively.
-Don't call it from programs!"
+Don't call it from programs: use `insert-buffer-substring' instead!"
(interactive
(list
(progn
(other-buffer (current-buffer))
(window-buffer (next-window (selected-window))))
t))))
- (or (bufferp buffer)
- (setq buffer (get-buffer buffer)))
- (let (start end newmark)
- (save-excursion
- (save-excursion
- (set-buffer buffer)
- (setq start (point-min) end (point-max)))
- (insert-buffer-substring buffer start end)
- (setq newmark (point)))
- (push-mark newmark))
+ (push-mark
+ (save-excursion
+ (insert-buffer-substring (get-buffer buffer))
+ (point)))
nil)
(defun append-to-buffer (buffer start end)
(defun set-mark-command (arg)
"Set mark at where point is, or jump to mark.
-With no prefix argument, set mark, push old mark position on local mark
-ring, and push mark on global mark ring. Immediately repeating the
-command activates `transient-mark-mode' temporarily.
+With no prefix argument, set mark, and push old mark position on local
+mark ring; also push mark on global mark ring if last mark was set in
+another buffer. Immediately repeating the command activates
+`transient-mark-mode' temporarily.
-With argument, jump to mark, and pop a new position for mark off the ring
-\(does not affect global mark ring\). Repeating the command without
-an argument jumps to the next position off the mark ring.
+With argument, e.g. \\[universal-argument] \\[set-mark-command], \
+jump to mark, and pop a new position
+for mark off the local mark ring \(this does not affect the global
+mark ring\). Use \\[pop-global-mark] to jump to a mark off the global
+mark ring \(see `pop-global-mark'\).
+
+Repeating the \\[set-mark-command] command without the prefix jumps to
+the next position off the local (or global) mark ring.
+
+With a double \\[universal-argument] prefix argument, e.g. \\[universal-argument] \
+\\[universal-argument] \\[set-mark-command], unconditionally
+set mark where point is.
Novice Emacs Lisp programmers often try to use the mark for the wrong
purposes. See the documentation of `set-mark' for more information."
(if (eq transient-mark-mode 'lambda)
(setq transient-mark-mode nil))
(cond
+ ((and (consp arg) (> (prefix-numeric-value arg) 4))
+ (push-mark-command nil))
((not (eq this-command 'set-mark-command))
(if arg
(pop-to-mark-command)
(push-mark-command t)))
((eq last-command 'pop-to-mark-command)
- (if (and (consp arg) (> (prefix-numeric-value arg) 4))
- (push-mark-command nil)
- (setq this-command 'pop-to-mark-command)
- (pop-to-mark-command)))
+ (setq this-command 'pop-to-mark-command)
+ (pop-to-mark-command))
+ ((and (eq last-command 'pop-global-mark) (not arg))
+ (setq this-command 'pop-global-mark)
+ (pop-global-mark))
(arg
(setq this-command 'pop-to-mark-command)
(pop-to-mark-command))
With prefix arg, `transient-mark-mode' is enabled temporarily."
(interactive "P")
(if arg
- (if mark-active
+ (if mark-active
(if (null transient-mark-mode)
(setq transient-mark-mode 'lambda))
(setq arg nil)))
(if (> (cdr pos1) (car pos2)) (error "Don't have two things to transpose"))
(atomic-change-group
(let (word2)
+ ;; FIXME: We first delete the two pieces of text, so markers that
+ ;; used to point to after the text end up pointing to before it :-(
(setq word2 (delete-and-extract-region (car pos2) (cdr pos2)))
(goto-char (car pos2))
(insert (delete-and-extract-region (car pos1) (cdr pos1)))
(not (and fill-indent-according-to-mode
(string-match "\\`[ \t]*\\'" prefix)))
(setq fill-prefix prefix))))
-
+
(while (and (not give-up) (> (current-column) fc))
;; Determine where to split the line.
(let* (after-prefix
(prin1 selective-display t)
(princ "." t))
+(defvaralias 'indicate-unused-lines 'indicate-empty-lines)
+(defvaralias 'default-indicate-unused-lines 'default-indicate-empty-lines)
+
(defun toggle-truncate-lines (arg)
"Toggle whether to fold or truncate long lines on the screen.
With arg, truncate long lines iff arg is positive.
'set-variable-value-history)))))
(list var val current-prefix-arg)))
+ (and (custom-variable-p var)
+ (not (get var 'custom-type))
+ (custom-load-symbol var))
(let ((type (get var 'custom-type)))
(when type
;; Match with custom type.
(if make-local
(make-local-variable var))
-
+
(set var val)
;; Force a thorough redisplay for the case that the variable
(not (equal buffer
(window-buffer (active-minibuffer-window))))))
(error "Minibuffer is not active for completion")
- (unless (run-hook-with-args-until-success
+ (unless (run-hook-with-args-until-success
'choose-completion-string-functions
choice buffer mini-p base-size)
;; Insert the completion into the buffer where it was requested.
(defun completion-setup-function ()
(save-excursion
- (let ((mainbuf (current-buffer)))
+ (let ((mainbuf (current-buffer))
+ (mbuf-contents (minibuffer-contents)))
+ ;; When reading a file name in the minibuffer,
+ ;; set default-directory in the minibuffer
+ ;; so it will get copied into the completion list buffer.
+ (if minibuffer-completing-file-name
+ (with-current-buffer mainbuf
+ (setq default-directory (file-name-directory mbuf-contents))))
(set-buffer standard-output)
(completion-list-mode)
(make-local-variable 'completion-reference-buffer)
(setq completion-reference-buffer mainbuf)
- (if (eq minibuffer-completion-table 'read-file-name-internal)
+ (if minibuffer-completing-file-name
;; For file name completion,
;; use the number of chars before the start of the
;; last file name component.
(- (point) (minibuffer-prompt-end))))
;; Otherwise, in minibuffer, the whole input is being completed.
(save-match-data
- (if (string-match "\\` \\*Minibuf-[0-9]+\\*\\'"
- (buffer-name mainbuf))
+ (if (minibufferp mainbuf)
(setq completion-base-size 0))))
(goto-char (point-min))
(if (display-mouse-p)
;; to the following event.
(defun event-apply-alt-modifier (ignore-prompt)
- "Add the Alt modifier to the following event.
+ "\\<function-key-map>Add the Alt modifier to the following event.
For example, type \\[event-apply-alt-modifier] & to enter Alt-&."
(vector (event-apply-modifier (read-event) 'alt 22 "A-")))
(defun event-apply-super-modifier (ignore-prompt)
- "Add the Super modifier to the following event.
+ "\\<function-key-map>Add the Super modifier to the following event.
For example, type \\[event-apply-super-modifier] & to enter Super-&."
(vector (event-apply-modifier (read-event) 'super 23 "s-")))
(defun event-apply-hyper-modifier (ignore-prompt)
- "Add the Hyper modifier to the following event.
+ "\\<function-key-map>Add the Hyper modifier to the following event.
For example, type \\[event-apply-hyper-modifier] & to enter Hyper-&."
(vector (event-apply-modifier (read-event) 'hyper 24 "H-")))
(defun event-apply-shift-modifier (ignore-prompt)
- "Add the Shift modifier to the following event.
+ "\\<function-key-map>Add the Shift modifier to the following event.
For example, type \\[event-apply-shift-modifier] & to enter Shift-&."
(vector (event-apply-modifier (read-event) 'shift 25 "S-")))
(defun event-apply-control-modifier (ignore-prompt)
- "Add the Ctrl modifier to the following event.
+ "\\<function-key-map>Add the Ctrl modifier to the following event.
For example, type \\[event-apply-control-modifier] & to enter Ctrl-&."
(vector (event-apply-modifier (read-event) 'control 26 "C-")))
(defun event-apply-meta-modifier (ignore-prompt)
- "Add the Meta modifier to the following event.
+ "\\<function-key-map>Add the Meta modifier to the following event.
For example, type \\[event-apply-meta-modifier] & to enter Meta-&."
(vector (event-apply-modifier (read-event) 'meta 27 "M-")))
(let ((args (process-contact process t)))
(setq args (plist-put args :name newname))
(setq args (plist-put args :buffer
- (if (process-buffer process) (current-buffer))))
+ (if (process-buffer process)
+ (current-buffer))))
(apply 'make-network-process args))
(apply 'start-process newname
(if (process-buffer process) (current-buffer))
new-process (process-inherit-coding-system-flag process))
(set-process-filter new-process (process-filter process))
(set-process-sentinel new-process (process-sentinel process))
+ (set-process-plist new-process (copy-sequence (process-plist process)))
new-process)))
;; things to maybe add (currently partly covered by `funcall mode'):
; (message "You cannot modify the prompt")))
;
;
-;(setq minibuffer-prompt-properties
+;(setq minibuffer-prompt-properties
; (list 'modification-hooks '(minibuffer-prompt-modification)
; 'insert-in-front-hooks '(minibuffer-prompt-insertion)))
-;
+;
(provide 'simple)
;;; simple.el ends here