;;; simple.el --- basic editing commands for Emacs
-;; Copyright (C) 1985, 1986, 1987, 1992, 1993 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1987, 1993 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;; Commentary:
+
+;; A grab-bag of basic Emacs commands not specifically related to some
+;; major mode or to file-handling.
+
;;; Code:
(defun open-line (arg)
(if (and buffer-undo-list (not (eq buffer-undo-list t)))
(setq buffer-undo-list (cons (point) buffer-undo-list)))
(forward-char -1)))
- (while (> arg 0)
- (save-excursion
- (insert ?\n))
- (if do-fill-prefix (insert fill-prefix))
- (setq arg (1- arg)))
+ (save-excursion
+ (while (> arg 0)
+ (if do-fill-prefix (insert fill-prefix))
+ (insert ?\n)
+ (setq arg (1- arg))))
+ (end-of-line)
(if flag (forward-char 1))))
(defun split-line ()
(defun quoted-insert (arg)
"Read next input character and insert it.
This is useful for inserting control characters.
-You may also type up to 3 octal digits, to insert a character with that code"
+You may also type up to 3 octal digits, to insert a character with that code.
+
+In overwrite mode, this function inserts the character anyway, and
+does not handle octal digits specially. This means that if you use
+overwrite as your normal editing mode, you can use this function to
+insert characters when necessary.
+
+In binary overwrite mode, this function does overwrite, and octal
+digits are interpreted as a character code. This is supposed to make
+this function useful in editing binary files."
(interactive "*p")
- (let ((char (read-quoted-char)))
- (while (> arg 0)
- (insert char)
- (setq arg (1- arg)))))
+ (let ((char (if (or (not overwrite-mode)
+ (eq overwrite-mode 'overwrite-mode-binary))
+ (read-quoted-char)
+ (read-char))))
+ (if (eq overwrite-mode 'overwrite-mode-binary)
+ (delete-char arg))
+ (insert-char char arg)))
(defun delete-indentation (&optional arg)
"Join this line to previous and fix up whitespace at join.
that uses or sets the mark."
(interactive)
(push-mark (point))
- (push-mark (point-max))
+ (push-mark (point-max) nil t)
(goto-char (point-min)))
(defun count-lines-region (start end)
- "Print number of lines and charcters in the region."
+ "Print number of lines and characters in the region."
(interactive "r")
(message "Region has %d lines, %d characters"
(count-lines start end) (- end start)))
This is usually the number of newlines between them,
but can be one more if START is not equal to END
and the greater of them is not at the start of a line."
- (save-excursion
- (save-restriction
- (narrow-to-region start end)
- (goto-char (point-min))
- (if (eq selective-display t)
- (let ((done 0))
- (while (re-search-forward "[\n\C-m]" nil t 40)
- (setq done (+ 40 done)))
- (while (re-search-forward "[\n\C-m]" nil t 1)
- (setq done (+ 1 done)))
- done)
- (- (buffer-size) (forward-line (buffer-size)))))))
+ (save-match-data
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (if (eq selective-display t)
+ (let ((done 0))
+ (while (re-search-forward "[\n\C-m]" nil t 40)
+ (setq done (+ 40 done)))
+ (while (re-search-forward "[\n\C-m]" nil t 1)
+ (setq done (+ 1 done)))
+ (goto-char (point-max))
+ (if (and (/= start end)
+ (not (bolp)))
+ (1+ done)
+ done))
+ (- (buffer-size) (forward-line (buffer-size))))))))
(defun what-cursor-position ()
"Print info on cursor position (on screen and within buffer)."
(interactive)
(kill-all-local-variables))
-(defvar read-expression-map (copy-keymap minibuffer-local-map)
+(defvar read-expression-map (cons 'keymap minibuffer-local-map)
"Minibuffer keymap used for reading Lisp expressions.")
(define-key read-expression-map "\M-\t" 'lisp-complete-symbol)
(put 'eval-expression 'disabled t)
-;; We define this, rather than making eval interactive,
+(defvar read-expression-history nil)
+
+;; We define this, rather than making `eval' interactive,
;; for the sake of completion of names like eval-region, eval-current-buffer.
(defun eval-expression (expression)
"Evaluate EXPRESSION and print value in minibuffer.
Value is also consed on to front of the variable `values'."
- (interactive (list (read-from-minibuffer "Eval: "
- nil read-expression-map t)))
+ (interactive
+ (list (read-from-minibuffer "Eval: "
+ nil read-expression-map t
+ 'read-expression-history)))
(setq values (cons (eval expression) values))
(prin1 (car values) t))
the minibuffer, then read and evaluate the result."
(let ((command (read-from-minibuffer prompt
(prin1-to-string command)
- read-expression-map t)))
- ;; Add edited command to command history, unless redundant.
- (or (equal command (car command-history))
- (setq command-history (cons command command-history)))
+ read-expression-map t
+ '(command-history . 1))))
(eval command)))
(defun repeat-complex-command (arg)
newcmd)
(if elt
(progn
- (setq newcmd (read-from-minibuffer "Redo: "
- (prin1-to-string elt)
- read-expression-map
- t
- (cons 'command-history
- arg)))
+ (setq newcmd
+ (read-from-minibuffer
+ "Redo: " (prin1-to-string elt) read-expression-map t
+ (cons 'command-history arg)))
+
;; If command was added to command-history as a string,
;; get rid of that. We want only evallable expressions there.
(if (stringp (car command-history))
(setq command-history (cdr command-history)))
+
;; If command to be redone does not match front of history,
;; add it to the history.
(or (equal newcmd (car command-history))
(car key-and-command)
(let ((command (cdr key-and-command)))
(if (consp command)
- (if (cdr keymap-and-completionp)
- (cdr command)
+ ;; (and ... nil) => ... turns back on the completion-oriented
+ ;; history commands which rms turned off since they seem to
+ ;; do things he doesn't like.
+ (if (and (cdr keymap-and-completionp) nil) ;XXX turned off
+ (progn (error "EMACS BUG!") (cdr command))
(car command))
command))))
'((minibuffer-local-map . nil)
(minibuffer-local-completion-map . t)
(minibuffer-local-must-match-map . t)
(read-expression-map . nil))))
- ;; In completion maps, use the completion-oriented history commands.
'(("\en" . (next-history-element . next-complete-history-element))
([next] . (next-history-element . next-complete-history-element))
("\ep" . (previous-history-element . previous-complete-history-element))
With prefix argument N, search for Nth previous match.
If N is negative, find the next or Nth next match."
(interactive
- (let ((enable-recursive-minibuffers t)
- (minibuffer-history-sexp-flag nil))
- (list (read-from-minibuffer "Previous element matching (regexp): "
- nil
- minibuffer-local-map
- nil
- 'minibuffer-history-search-history)
+ (let* ((enable-recursive-minibuffers t)
+ (minibuffer-history-sexp-flag nil)
+ (regexp (read-from-minibuffer "Previous element matching (regexp): "
+ nil
+ minibuffer-local-map
+ nil
+ 'minibuffer-history-search-history)))
+ ;; Use the last regexp specified, by default, if input is empty.
+ (list (if (string= regexp "")
+ (setcar minibuffer-history-search-history
+ (nth 1 minibuffer-history-search-history))
+ regexp)
(prefix-numeric-value current-prefix-arg))))
(let ((history (symbol-value minibuffer-history-variable))
prevpos
With prefix argument N, search for Nth next match.
If N is negative, find the previous or Nth previous match."
(interactive
- (let ((enable-recursive-minibuffers t)
- (minibuffer-history-sexp-flag nil))
- (list (read-from-minibuffer "Next element matching (regexp): "
- nil
- minibuffer-local-map
- nil
- 'minibuffer-history-search-history)
+ (let* ((enable-recursive-minibuffers t)
+ (minibuffer-history-sexp-flag nil)
+ (regexp (read-from-minibuffer "Next element matching (regexp): "
+ nil
+ minibuffer-local-map
+ nil
+ 'minibuffer-history-search-history)))
+ ;; Use the last regexp specified, by default, if input is empty.
+ (list (if (string= regexp "")
+ (setcar minibuffer-history-search-history
+ (nth 1 minibuffer-history-search-history))
+ regexp)
(prefix-numeric-value current-prefix-arg))))
(previous-matching-history-element regexp (- n)))
(next-history-element (- n)))
(defun next-complete-history-element (n)
- "\
-Get previous element of history which is a completion of minibuffer contents."
+ "Get next element of history which is a completion of minibuffer contents."
(interactive "p")
- (next-matching-history-element (concat "^" (regexp-quote (buffer-string)))
- n))
+ (let ((point-at-start (point)))
+ (next-matching-history-element
+ (concat "^" (regexp-quote (buffer-substring (point-min) (point)))) n)
+ ;; next-matching-history-element always puts us at (point-min).
+ ;; Move to the position we were at before changing the buffer contents.
+ ;; This is still sensical, because the text before point has not changed.
+ (goto-char point-at-start)))
(defun previous-complete-history-element (n)
- "Get next element of history which is a completion of minibuffer contents."
+ "\
+Get previous element of history which is a completion of minibuffer contents."
(interactive "p")
(next-complete-history-element (- n)))
\f
(forward-line (1- arg)))))
;Put this on C-x u, so we can force that rather than C-_ into startup msg
-(fset 'advertised-undo 'undo)
+(define-function 'advertised-undo 'undo)
(defun undo (&optional arg)
"Undo some previous changes.
Repeat this command to undo more changes.
A numeric argument serves as a repeat count."
(interactive "*p")
- (let ((modified (buffer-modified-p)))
+ (let ((modified (buffer-modified-p))
+ (recent-save (recent-auto-save-p)))
(or (eq (selected-window) (minibuffer-window))
(message "Undo!"))
(or (eq last-command 'undo)
(setq this-command 'undo)
(undo-more (or arg 1))
(and modified (not (buffer-modified-p))
- (delete-auto-save-file-if-necessary))))
+ (delete-auto-save-file-if-necessary recent-save))))
+
+(defvar pending-undo-list nil
+ "Within a run of consecutive undo commands, list remaining to be undone.")
(defun undo-start ()
"Set `pending-undo-list' to the front of the undo list.
(error "No further undo information"))
(setq pending-undo-list (primitive-undo count pending-undo-list)))
-(defvar last-shell-command "")
-(defvar last-shell-command-on-region "")
+(defvar shell-command-history nil
+ "History list for some commands that read shell commands.")
(defun shell-command (command &optional flag)
"Execute string COMMAND in inferior shell; display output, if any.
Optional second arg non-nil (prefix arg, if interactive)
means insert output in current buffer after point (leave mark after it).
This cannot be done asynchronously."
- (interactive (list (read-string "Shell command: " last-shell-command)
+ (interactive (list (read-from-minibuffer "Shell command: "
+ nil nil nil 'shell-command-history)
current-prefix-arg))
(if flag
(progn (barf-if-buffer-read-only)
;; aliases for shell commands then they can still have them.
(call-process shell-file-name nil t nil
"-c" command)
- (exchange-point-and-mark))
+ ;; This is like exchange-point-and-mark, but doesn't activate the mark.
+ ;; It is cleaner to avoid activation, even though the command
+ ;; loop would deactivate the mark because we inserted text.
+ (goto-char (prog1 (mark t)
+ (set-marker (mark-marker) (point)
+ (current-buffer)))))
;; Preserve the match data in case called from a program.
(let ((data (match-data)))
(unwind-protect
or output is inserted in the current buffer then `*Shell Command Output*' is
deleted."
(interactive (list (region-beginning) (region-end)
- (read-string "Shell command on region: "
- last-shell-command-on-region)
+ (read-from-minibuffer "Shell command on region: "
+ nil nil nil 'shell-command-history)
current-prefix-arg
(prefix-numeric-value current-prefix-arg)))
(if flag
(progn
(describe-arg value sign)
(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.
- (setq unread-command-event (aref key 0))
- ;; We can't push back a longer string, so we'll emulate the
- ;; command loop ourselves.
- (command-execute (key-binding key)))))
+ (setq unread-command-events (listify-key-sequence key))))
(defun describe-arg (value sign)
(cond ((numberp value)
(forward-line (- arg))
(skip-chars-forward " \t"))
+(defvar kill-whole-line nil
+ "*If non-nil, `kill-line' with no arg at beg of line kills the whole line.")
+
(defun kill-line (&optional arg)
"Kill the rest of the current line; if no nonblanks there, kill thru newline.
With prefix argument, kill that many lines from point.
Negative arguments kill lines backward.
When calling from a program, nil means \"no arg\",
-a number counts as a prefix arg."
+a number counts as a prefix arg.
+
+If `kill-whole-line' is non-nil, then kill the whole line
+when given no argument at the beginning of a line."
(interactive "P")
(kill-region (point)
;; Don't shift point before doing the delete; that way,
(forward-line (prefix-numeric-value arg))
(if (eobp)
(signal 'end-of-buffer nil))
- (if (looking-at "[ \t]*$")
+ (if (or (looking-at "[ \t]*$") (and kill-whole-line (bolp)))
(forward-line 1)
(end-of-line)))
(point))))
"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
+pasting text between the windows of different programs.
+This variable holds a function that Emacs calls 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.")
+The function takes one or two arguments.
+The first argument, TEXT, is a string containing
+the text which should be made available.
+The second, PUSH, if non-nil means this is a \"new\" kill;
+nil means appending to an \"old\" kill.")
(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
+pasting text between the windows of different programs.
+This variable holds a function that Emacs calls to obtain
text that other programs have provided for pasting.
The function should be called with no arguments. If the function
(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)))
+ (funcall interprogram-cut-function string t)))
(defun kill-append (string before-p)
"Append STRING to the end of the latest kill in the kill ring.
(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)))
+ (let ((ARGth-kill-element
+ (nthcdr (mod (- n (length kill-ring-yank-pointer))
+ (length kill-ring))
+ kill-ring)))
(or do-not-move
(setq kill-ring-yank-pointer ARGth-kill-element))
(car ARGth-kill-element)))))
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].)
+If the buffer is read-only, Emacs will beep and refrain from deleting
+the text, but put the text in the kill ring anyway. This means that
+you can use the killing commands to copy text from a read-only buffer.
This is the primitive for programs to kill text (as opposed to deleting it).
Supply two arguments, character numbers indicating the stretch of text
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."
- (interactive "*r")
+ (interactive "r")
(cond
- ;; If the buffer was read-only, we used to just do a
- ;; copy-region-as-kill. This was never what I wanted - usually I
- ;; was making a mistake and trying to edit a file checked into RCS -
- ;; so I've taken the code out.
+
+ ;; If the buffer is read-only, we should beep, in case the person
+ ;; just isn't aware of this. However, there's no harm in putting
+ ;; the region's text in the kill ring, anyway.
+ (buffer-read-only
+ (copy-region-as-kill beg end)
+ ;; This should always barf, and give us the correct error.
+ (barf-if-buffer-read-only))
+
+ ;; In certain cases, we can arrange for the undo list and the kill
+ ;; ring to share the same string object. This code does that.
((not (or (eq buffer-undo-list t)
(eq last-command 'kill-region)
- (eq beg end)))
+ (equal beg end)))
;; Don't let the undo list be truncated before we can even access it.
- (let ((undo-strong-limit (+ (- (max beg end) (min beg end)) 100)))
+ (let ((undo-strong-limit (+ (- (max beg end) (min beg end)) 100))
+ (old-list buffer-undo-list)
+ tail)
(delete-region beg end)
+ ;; Search back in buffer-undo-list for this string,
+ ;; in case a change hook made property changes.
+ (setq tail buffer-undo-list)
+ (while (not (stringp (car (car tail))))
+ (setq tail (cdr tail)))
;; Take the same string recorded for undo
;; and put it in the kill-ring.
- (kill-new (car (car buffer-undo-list)))
+ (kill-new (car (car tail)))
(setq this-command 'kill-region)))
+
(t
(copy-region-as-kill beg end)
(delete-region beg end))))
nil)
(defun kill-ring-save (beg end)
- "Save the region as if killed, but don't kill it."
+ "Save the region as if killed, but don't kill it.
+This command is similar to `copy-region-as-kill', except that it gives
+visual feedback indicating the extent of the region being copied.
+If `interprogram-cut-function' is non-nil, also save the text for a window
+system cut and paste."
(interactive "r")
(copy-region-as-kill beg end)
(if (interactive-p)
- (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)))
- (if (= (point) beg)
- ;; Don't say "killed"; that is misleading.
- (message "Saved text until \"%s\""
- (substring killed-text (- message-len)))
- (message "Saved text from \"%s\""
- (substring killed-text 0 message-len)))))))))
+ (let ((other-end (if (= (point) beg) end beg))
+ (opoint (point))
+ ;; Inhibit quitting so we can make a quit here
+ ;; look like a C-g typed as a command.
+ (inhibit-quit t))
+ (if (pos-visible-in-window-p other-end (selected-window))
+ (progn
+ ;; Swap point and mark.
+ (set-marker (mark-marker) (point) (current-buffer))
+ (goto-char other-end)
+ (sit-for 1)
+ ;; Swap back.
+ (set-marker (mark-marker) other-end (current-buffer))
+ (goto-char opoint)
+ ;; If user quit, deactivate the mark
+ ;; as C-g would as a command.
+ (and quit-flag mark-active
+ (deactivate-mark)))
+ (let* ((killed-text (current-kill 0))
+ (message-len (min (length killed-text) 40)))
+ (if (= (point) beg)
+ ;; Don't say "killed"; that is misleading.
+ (message "Saved text until \"%s\""
+ (substring killed-text (- message-len)))
+ (message "Saved text from \"%s\""
+ (substring killed-text 0 message-len))))))))
(defun append-next-kill ()
"Cause following command, if it kills, to append to previous kill."
(if (not (eq last-command 'yank))
(error "Previous command was not a yank"))
(setq this-command 'yank)
- (let ((before (< (point) (mark))))
- (delete-region (point) (mark))
- (set-mark (point))
+ (let ((before (< (point) (mark t))))
+ (delete-region (point) (mark t))
+ (set-marker (mark-marker) (point) (current-buffer))
(insert (current-kill arg))
- (if before (exchange-point-and-mark))))
+ (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
+ ;; loop would deactivate the mark because we inserted text.
+ (goto-char (prog1 (mark t)
+ (set-marker (mark-marker) (point) (current-buffer))))))
+ nil)
(defun yank (&optional arg)
"Reinsert the last stretch of killed text.
((eq arg '-) -1)
(t (1- arg)))))
(if (consp arg)
- (exchange-point-and-mark)))
+ ;; This is like exchange-point-and-mark, but doesn't activate the mark.
+ ;; It is cleaner to avoid activation, even though the command
+ ;; loop would deactivate the mark because we inserted text.
+ (goto-char (prog1 (mark t)
+ (set-marker (mark-marker) (point) (current-buffer)))))
+ nil)
(defun rotate-yank-pointer (arg)
"Rotate the yanking point in the kill ring.
(setq start (point-min) end (point-max)))
(insert-buffer-substring buffer start end)
(setq newmark (point)))
- (push-mark newmark)))
+ (push-mark newmark))
+ nil)
(defun append-to-buffer (buffer start end)
"Append to specified buffer the text of the region.
BUFFER (or buffer name), START and END.
START and END specify the portion of the current buffer to be copied."
(interactive
- (list (read-buffer "Append to buffer: " (other-buffer nil t) t)))
+ (list (read-buffer "Append to buffer: " (other-buffer nil t))
+ (region-beginning) (region-end)))
(let ((oldbuf (current-buffer)))
(save-excursion
(set-buffer (get-buffer-create buffer))
(save-excursion
(insert-buffer-substring oldbuf start end)))))
\f
-(defun mark ()
- "Return this buffer's mark value as integer, or nil if no mark.
+(defvar mark-even-if-inactive nil
+ "*Non-nil means you can use the mark even when inactive.
+This option makes a difference in Transient Mark mode.
+When the option is non-nil, deactivation of the mark
+turns off region highlighting, but commands that use the mark
+behave as if the mark were still active.")
+
+(put 'mark-inactive 'error-conditions '(mark-inactive error))
+(put 'mark-inactive 'error-message "The mark is not active now")
+
+(defun mark (&optional force)
+ "Return this buffer's mark value as integer; error if mark inactive.
+If optional argument FORCE is non-nil, access the mark value
+even if the mark is not currently active, and return nil
+if there is no mark at all.
+
If you are using this in an editing command, you are most likely making
a mistake; see the documentation of `set-mark'."
- (marker-position (mark-marker)))
+ (if (or force mark-active mark-even-if-inactive)
+ (marker-position (mark-marker))
+ (signal 'mark-inactive nil)))
+
+;; Many places set mark-active directly, and several of them failed to also
+;; run deactivate-mark-hook. This shorthand should simplify.
+(defsubst deactivate-mark ()
+ "Deactivate the mark by setting `mark-active' to nil.
+\(That makes a difference only in Transient Mark mode.)
+Also runs the hook `deactivate-mark-hook'."
+ (setq mark-active nil)
+ (run-hooks 'deactivate-mark-hook))
(defun set-mark (pos)
"Set this buffer's mark to POS. Don't use this function!
(let ((beg (point))) (forward-line 1) (delete-region beg (point)))."
- (set-marker (mark-marker) pos (current-buffer)))
+ (if pos
+ (progn
+ (setq mark-active t)
+ (run-hooks 'activate-mark-hook)
+ (set-marker (mark-marker) pos (current-buffer)))
+ (deactivate-mark)
+ (set-marker (mark-marker) pos (current-buffer))))
(defvar mark-ring nil
"The list of saved former marks of the current buffer,
purposes. See the documentation of `set-mark' for more information."
(interactive "P")
(if (null arg)
- (push-mark)
- (if (null (mark))
+ (progn
+ (push-mark nil nil t))
+ (if (null (mark t))
(error "No mark set in this buffer")
- (goto-char (mark))
+ (goto-char (mark t))
(pop-mark))))
-(defun push-mark (&optional location nomsg)
+(defun push-mark (&optional location nomsg activate)
"Set mark at LOCATION (point, by default) and push old mark on mark ring.
-Displays \"Mark set\" unless the optional second arg NOMSG is non-nil.
+Display `Mark set' unless the optional second arg NOMSG is non-nil.
+In Transient Mark mode, activate mark if optional third arg ACTIVATE non-nil.
Novice Emacs Lisp programmers often try to use the mark for the wrong
-purposes. See the documentation of `set-mark' for more information."
- (if (null (mark))
+purposes. See the documentation of `set-mark' for more information.
+
+In Transient Mark mode, this does not activate the mark."
+ (if (null (mark t))
nil
(setq mark-ring (cons (copy-marker (mark-marker)) mark-ring))
(if (> (length mark-ring) mark-ring-max)
(progn
(move-marker (car (nthcdr mark-ring-max mark-ring)) nil)
(setcdr (nthcdr (1- mark-ring-max) mark-ring) nil))))
- (set-mark (or location (point)))
+ (set-marker (mark-marker) (or location (point)) (current-buffer))
(or nomsg executing-macro (> (minibuffer-depth) 0)
(message "Mark set"))
+ (if (or activate (not transient-mark-mode))
+ (set-mark (mark t)))
nil)
(defun pop-mark ()
(if mark-ring
(progn
(setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker)))))
- (set-mark (+ 0 (car mark-ring)))
+ (set-marker (mark-marker) (+ 0 (car mark-ring)) (current-buffer))
+ (deactivate-mark)
(move-marker (car mark-ring) nil)
- (if (null (mark)) (ding))
+ (if (null (mark t)) (ding))
(setq mark-ring (cdr mark-ring)))))
-(fset 'exchange-dot-and-mark 'exchange-point-and-mark)
+(define-function 'exchange-dot-and-mark 'exchange-point-and-mark)
(defun exchange-point-and-mark ()
- "Put the mark where point is now, and point where the mark is now."
+ "Put the mark where point is now, and point where the mark is now.
+This command works even when the mark is not active,
+and it reactivates the mark."
(interactive nil)
- (let ((omark (mark)))
+ (let ((omark (mark t)))
(if (null omark)
(error "No mark set in this buffer"))
(set-mark (point))
(goto-char omark)
nil))
+
+(defun transient-mark-mode (arg)
+ "Toggle Transient Mark mode.
+With arg, turn Transient Mark mode on if arg is positive, off otherwise.
+
+In Transient Mark mode, when the mark is active, the region is highlighted.
+Changing the buffer \"deactivates\" the mark.
+So do certain other operations that set the mark
+but whose main purpose is something else--for example,
+incremental search, \\[beginning-of-buffer], and \\[end-of-buffer]."
+ (interactive "P")
+ (setq transient-mark-mode
+ (if (null arg)
+ (not transient-mark-mode)
+ (> (prefix-numeric-value arg) 0))))
\f
+(defvar next-line-add-newlines t
+ "*If non-nil, `next-line' inserts newline to avoid `end of buffer' error.")
+
(defun next-line (arg)
"Move cursor vertically down ARG lines.
If there is no character in the target line exactly under the current column,
the cursor is positioned after the character in that line which spans this
column, or at the end of the line if it is not long enough.
-If there is no line in the buffer after this one,
-a newline character is inserted to create a line
-and the cursor moves to that line.
+If there is no line in the buffer after this one, behavior depends on the
+value of next-line-add-newlines. If non-nil, a newline character is inserted
+to create a line and the cursor moves to that line, otherwise the cursor is
+moved to the end of the buffer (if already at the end of the buffer, an error
+is signaled).
The command \\[set-goal-column] can be used to create
a semipermanent goal column to which this command always moves.
using `forward-line' instead. It is usually easier to use
and more reliable (no dependence on goal column, etc.)."
(interactive "p")
- (if (= arg 1)
- (let ((opoint (point)))
- (forward-line 1)
- (if (or (= opoint (point))
- (not (eq (preceding-char) ?\n)))
- (insert ?\n)
- (goto-char opoint)
- (line-move arg)))
- (line-move arg))
+ (let ((opoint (point)))
+ (if next-line-add-newlines
+ (if (/= arg 1)
+ (line-move arg)
+ (forward-line 1)
+ (if (or (= opoint (point)) (not (eq (preceding-char) ?\n)))
+ (insert ?\n)
+ (goto-char opoint)
+ (line-move arg)))
+ (if (eobp)
+ (signal 'end-of-buffer nil))
+ (line-move arg)
+ (if (= opoint (point))
+ (end-of-line))))
nil)
(defun previous-line (arg)
goal-column))
nil)
\f
+;;; Partial support for horizontal autoscrolling. Someday, this feature
+;;; will be built into the C level and all the (hscroll-point-visible) calls
+;;; will go away.
+
+(defvar hscroll-step 0
+ "*The number of columns to try scrolling a window by when point moves out.
+If that fails to bring point back on frame, point is centered instead.
+If this is zero, point is always centered after it moves off frame.")
+
+(defun hscroll-point-visible ()
+ "Scrolls the window horizontally to make point visible."
+ (let* ((here (current-column))
+ (left (window-hscroll))
+ (right (- (+ left (window-width)) 3)))
+ (cond
+ ;; Should we recenter?
+ ((or (< here (- left hscroll-step))
+ (> here (+ right hscroll-step)))
+ (set-window-hscroll
+ (selected-window)
+ ;; Recenter, but don't show too much white space off the end of
+ ;; the line.
+ (max 0
+ (min (- (save-excursion (end-of-line) (current-column))
+ (window-width)
+ -5)
+ (- here (/ (window-width) 2))))))
+ ;; Should we scroll left?
+ ((> here right)
+ (scroll-left hscroll-step))
+ ;; Or right?
+ ((< here left)
+ (scroll-right hscroll-step)))))
+
+;; rms: (1) The definitions of arrow keys should not simply restate
+;; what keys they are. The arrow keys should run the ordinary commands.
+;; (2) The arrow keys are just one of many common ways of moving point
+;; within a line. Real horizontal autoscrolling would be a good feature,
+;; but supporting it only for arrow keys is too incomplete to be desirable.
+
+;;;;; Make arrow keys do the right thing for improved terminal support
+;;;;; When we implement true horizontal autoscrolling, right-arrow and
+;;;;; left-arrow can lose the (if truncate-lines ...) clause and become
+;;;;; aliases. These functions are bound to the corresponding keyboard
+;;;;; events in loaddefs.el.
+
+;;(defun right-arrow (arg)
+;; "Move right one character on the screen (with prefix ARG, that many chars).
+;;Scroll right if needed to keep point horizontally onscreen."
+;; (interactive "P")
+;; (forward-char arg)
+;; (hscroll-point-visible))
+
+;;(defun left-arrow (arg)
+;; "Move left one character on the screen (with prefix ARG, that many chars).
+;;Scroll left if needed to keep point horizontally onscreen."
+;; (interactive "P")
+;; (backward-char arg)
+;; (hscroll-point-visible))
+\f
(defun transpose-chars (arg)
"Interchange characters around point, moving forward one character.
With prefix arg ARG, effect is to take character before point
"*String to insert to end a new comment.
Should be an empty string if comments are terminated by end-of-line.")
-(defconst comment-indent-hook
+(defconst comment-indent-hook nil
+ "Obsolete variable for function to compute desired indentation for a comment.
+This function is called with no args with point at the beginning of
+the comment's starting delimiter.")
+
+(defconst comment-indent-function
'(lambda () comment-column)
"Function to compute desired indentation for a comment.
This function is called with no args with point at the beginning of
;; position at the end of the first pair.
(if (match-end 1)
(goto-char (match-end 1))
- ;; If comment-start-skip matched a string with internal
- ;; whitespace (not final whitespace) then the delimiter
- ;; start at the end of that whitespace.
- ;; Otherwise, it starts at the beginning of what was matched.
- (skip-chars-backward " \t" (match-beginning 0))
- (skip-chars-backward "^ \t" (match-beginning 0)))))
+ ;; If comment-start-skip matched a string with
+ ;; internal whitespace (not final whitespace) then
+ ;; the delimiter start at the end of that
+ ;; whitespace. Otherwise, it starts at the
+ ;; beginning of what was matched.
+ (skip-syntax-backward " " (match-beginning 0))
+ (skip-syntax-backward "^ " (match-beginning 0)))))
(setq begpos (point))
;; Compute desired indent.
(if (= (current-column)
- (setq indent (funcall comment-indent-hook)))
+ (setq indent (if comment-indent-hook
+ (funcall comment-indent-hook)
+ (funcall comment-indent-function))))
(goto-char begpos)
;; If that's different from current, change it.
(skip-chars-backward " \t")
(push-mark
(save-excursion
(forward-word arg)
- (point))))
+ (point))
+ nil t))
(defun kill-word (arg)
"Kill characters forward until encountering the end of a word.
With argument, do this that many times."
(interactive "p")
(kill-word (- arg)))
+
+(defun current-word ()
+ "Return the word point is on as a string, if it's between two
+word-constituent characters. If not, but it immediately follows one,
+move back first. Otherwise, if point precedes a word constituent,
+move forward first. Otherwise, move backwards until a word constituent
+is found and get that word; if you reach a newline first, move forward
+instead."
+ (interactive)
+ (save-excursion
+ (let ((oldpoint (point)) (start (point)) (end (point)))
+ (skip-syntax-backward "w_") (setq start (point))
+ (goto-char oldpoint)
+ (skip-syntax-forward "w_") (setq end (point))
+ (if (and (eq start oldpoint) (eq end oldpoint))
+ (progn
+ (skip-syntax-backward "^w_"
+ (save-excursion (beginning-of-line) (point)))
+ (if (eq (preceding-char) ?\n)
+ (progn
+ (skip-syntax-forward "^w_")
+ (setq start (point))
+ (skip-syntax-forward "w_")
+ (setq end (point)))
+ (setq end (point))
+ (skip-syntax-backward "w_")
+ (setq start (point)))))
+ (buffer-substring start end))))
\f
(defconst fill-prefix nil
"*String for filling to insert at front of new line, or nil for none.
(if (save-excursion
(goto-char fill-point)
(not (bolp)))
- ;; If point is at the fill-point, do not `save-excursion'.
- ;; Otherwise, if a comment prefix or fill-prefix is inserted,
- ;; point will end up before it rather than after it.
- (if (save-excursion
- (skip-chars-backward " \t")
- (= (point) fill-point))
- (indent-new-comment-line)
- (save-excursion
- (goto-char fill-point)
- (indent-new-comment-line)))
+ (let ((prev-column (current-column)))
+ ;; If point is at the fill-point, do not `save-excursion'.
+ ;; Otherwise, if a comment prefix or fill-prefix is inserted,
+ ;; point will end up before it rather than after it.
+ (if (save-excursion
+ (skip-chars-backward " \t")
+ (= (point) fill-point))
+ (indent-new-comment-line)
+ (save-excursion
+ (goto-char fill-point)
+ (indent-new-comment-line)))
+ ;; If making the new line didn't reduce the hpos of
+ ;; the end of the line, then give up now;
+ ;; trying again will not help.
+ (if (>= (current-column) prev-column)
+ (setq give-up t)))
;; No place to break => stop trying.
(setq give-up t)))))))
(prin1 selective-display t)
(princ "." t))
+(defconst overwrite-mode-textual " Ovwrt"
+ "The string displayed in the mode line when in overwrite mode.")
+(defconst overwrite-mode-binary " Bin Ovwrt"
+ "The string displayed in the mode line when in binary overwrite mode.")
+
(defun overwrite-mode (arg)
"Toggle overwrite mode.
With arg, turn overwrite mode on iff arg is positive.
In overwrite mode, printing characters typed in replace existing text
-on a one-for-one basis, rather than pushing it to the right."
+on a one-for-one basis, rather than pushing it to the right. At the
+end of a line, such characters extend the line. Before a tab,
+such characters insert until the tab is filled in.
+\\[quoted-insert] still inserts characters in overwrite mode; this
+is supposed to make it easier to insert characters when necessary."
(interactive "P")
(setq overwrite-mode
- (if (null arg) (not overwrite-mode)
- (> (prefix-numeric-value arg) 0)))
- (set-buffer-modified-p (buffer-modified-p))) ;No-op, but updates mode line.
+ (if (if (null arg) (not overwrite-mode)
+ (> (prefix-numeric-value arg) 0))
+ 'overwrite-mode-textual))
+ (force-mode-line-update))
+
+(defun binary-overwrite-mode (arg)
+ "Toggle binary overwrite mode.
+With arg, turn binary overwrite mode on iff arg is positive.
+In binary overwrite mode, printing characters typed in replace
+existing text. Newlines are not treated specially, so typing at the
+end of a line joins the line to the next, with the typed character
+between them. Typing before a tab character simply replaces the tab
+with the character typed.
+\\[quoted-insert] replaces the text at the cursor, just as ordinary
+typing characters do.
+
+Note that binary overwrite mode is not its own minor mode; it is a
+specialization of overwrite-mode, entered by setting the
+`overwrite-mode' variable to `overwrite-mode-binary'."
+ (interactive "P")
+ (setq overwrite-mode
+ (if (if (null arg)
+ (not (eq overwrite-mode 'overwrite-mode-binary))
+ (> (prefix-numeric-value arg) 0))
+ 'overwrite-mode-binary))
+ (force-mode-line-update))
\f
+(defvar line-number-mode nil
+ "*Non-nil means display line number in mode line.")
+
+(defun line-number-mode (arg)
+ "Toggle Line Number mode.
+With arg, turn Line Number mode on iff arg is positive.
+When Line Number mode is enabled, the line number appears
+in the mode line."
+ (interactive "P")
+ (setq line-number-mode
+ (if (null arg) (not line-number-mode)
+ (> (prefix-numeric-value arg) 0)))
+ (force-mode-line-update))
+
(defvar blink-matching-paren t
"*Non-nil means show matching open-paren when close-paren is inserted.")
-(defconst blink-matching-paren-distance 4000
- "*If non-nil, is maximum distance to search for matching open-paren
-when close-paren is inserted.")
+(defconst blink-matching-paren-distance 12000
+ "*If non-nil, is maximum distance to search for matching open-paren.")
(defun blink-matching-open ()
"Move cursor momentarily to the beginning of the sexp before point."
(interactive)
(and (> (point) (1+ (point-min)))
- (/= (char-syntax (char-after (- (point) 2))) ?\\ )
+ (not (memq (char-syntax (char-after (- (point) 2))) '(?/ ?\\ )))
blink-matching-paren
(let* ((oldpos (point))
(blinkpos)
;Turned off because it makes dbx bomb out.
(setq blink-paren-function 'blink-matching-open)
-; this is just something for the luser to see in a keymap -- this is not
-; how quitting works normally!
+;; This executes C-g typed while Emacs is waiting for a command.
+;; Quitting out of a program does not go through here;
+;; that happens in the QUIT macro at the C code level.
(defun keyboard-quit ()
- "Signal a quit condition."
+ "Signal a quit condition.
+During execution of Lisp code, this character causes a quit directly.
+At top-level, as an editor command, this simply beeps."
(interactive)
+ (deactivate-mark)
(signal 'quit nil))
(define-key global-map "\C-g" 'keyboard-quit)
'arg))
(eval-minibuffer (format "Set %s to value: " var)))))))
(set var val))
+\f
+;; Define the major mode for lists of completions.
+
+(defvar completion-list-mode-map nil)
+(or completion-list-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [mouse-2] 'mouse-choose-completion)
+ (setq completion-list-mode-map map)))
+
+;; Completion mode is suitable only for specially formatted data.
+(put 'completion-list-mode 'mode-class 'special)
+
+(defun completion-list-mode ()
+ "Major mode for buffers showing lists of possible completions.
+Type \\<completion-list-mode-map>\\[mouse-choose-completion] to select
+a completion with the mouse."
+ (interactive)
+ (kill-all-local-variables)
+ (use-local-map completion-list-mode-map)
+ (setq mode-name "Completion List")
+ (setq major-mode 'completion-list-mode)
+ (run-hooks 'completion-list-mode-hook))
+
+(defun completion-setup-function ()
+ (save-excursion
+ (completion-list-mode)
+ (goto-char (point-min))
+ (if window-system
+ (insert (substitute-command-keys
+ "Click \\[mouse-choose-completion] on a completion to select it.\n\n")))))
+
+(add-hook 'completion-setup-hook 'completion-setup-function)
+\f
+;;;; Keypad support.
+
+;;; Make the keypad keys act like ordinary typing keys. If people add
+;;; bindings for the function key symbols, then those bindings will
+;;; override these, so this shouldn't interfere with any existing
+;;; bindings.
+
+;; Also tell read-char how to handle these keys.
+(mapcar
+ (lambda (keypad-normal)
+ (let ((keypad (nth 0 keypad-normal))
+ (normal (nth 1 keypad-normal)))
+ (put keypad 'ascii-character normal)
+ (define-key function-key-map (vector keypad) (vector normal))))
+ '((kp-0 ?0) (kp-1 ?1) (kp-2 ?2) (kp-3 ?3) (kp-4 ?4)
+ (kp-5 ?5) (kp-6 ?6) (kp-7 ?7) (kp-8 ?8) (kp-9 ?9)
+ (kp-space ?\ )
+ (kp-tab ?\t)
+ (kp-enter ?\r)
+ (kp-multiply ?*)
+ (kp-add ?+)
+ (kp-separator ?,)
+ (kp-subtract ?-)
+ (kp-decimal ?.)
+ (kp-divide ?/)
+ (kp-equal ?=)))
;;; simple.el ends here
HCoop / bpt / emacs.git / blobdiff