;;; simple.el --- basic editing commands for Emacs
-;; Copyright (C) 1985, 1986, 1987, 1992 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)
(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)
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)))
+ done)
+ (- (buffer-size) (forward-line (buffer-size))))))))
(defun what-cursor-position ()
"Print info on cursor position (on screen and within buffer)."
(defvar minibuffer-history-search-history nil)
(mapcar
- (function (lambda (key-and-command)
- (mapcar
- (function (lambda (keymap)
- (define-key (symbol-value keymap)
- (car key-and-command)
- (cdr key-and-command))))
- '(minibuffer-local-map
- minibuffer-local-ns-map
- minibuffer-local-completion-map
- minibuffer-local-must-match-map
- read-expression-map))))
- '(("\en" . next-history-element) ([next] . next-history-element)
- ("\ep" . previous-history-element) ([prior] . previous-history-element)
+ (lambda (key-and-command)
+ (mapcar
+ (lambda (keymap-and-completionp)
+ ;; Arg is (KEYMAP-SYMBOL . COMPLETION-MAP-P).
+ ;; If the cdr of KEY-AND-COMMAND (the command) is a cons,
+ ;; its car is used if COMPLETION-MAP-P is nil, its cdr if it is t.
+ (define-key (symbol-value (car keymap-and-completionp))
+ (car key-and-command)
+ (let ((command (cdr key-and-command)))
+ (if (consp 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-ns-map . nil)
+ (minibuffer-local-completion-map . t)
+ (minibuffer-local-must-match-map . t)
+ (read-expression-map . nil))))
+ '(("\en" . (next-history-element . next-complete-history-element))
+ ([next] . (next-history-element . next-complete-history-element))
+ ("\ep" . (previous-history-element . previous-complete-history-element))
+ ([prior] . (previous-history-element . previous-complete-history-element))
("\er" . previous-matching-history-element)
("\es" . next-matching-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)))
"Inserts the previous element of the minibuffer history into the minibuffer."
(interactive "p")
(next-history-element (- n)))
+
+(defun next-complete-history-element (n)
+ "\
+Get previous element of history which is a completion of minibuffer contents."
+ (interactive "p")
+ (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."
+ (interactive "p")
+ (next-complete-history-element (- n)))
\f
(defun goto-line (arg)
"Goto line ARG, counting from line 1 at beginning of buffer."
(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.
(and modified (not (buffer-modified-p))
(delete-auto-save-file-if-necessary))))
+(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.
The next call to `undo-more' will undo the most recently made change."
;; 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
even though that buffer is not automatically displayed. If there is no output
or output is inserted in the current buffer then `*Shell Command Output*' is
deleted."
- (interactive (list (min (point) (mark)) (max (point) (mark))
+ (interactive (list (region-beginning) (region-end)
(read-string "Shell command on region: "
last-shell-command-on-region)
current-prefix-arg
(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-char (string-to-char key))
- ;; 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)
- (progn
+ ;; Don't shift point before doing the delete; that way,
+ ;; undo will record the right position of point.
+ (save-excursion
(if arg
(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.
If BEFORE-P is non-nil, prepend STRING to the kill.
-If 'interprogram-cut-function' is set, pass the resulting kill to
+If `interprogram-cut-function' is set, pass the resulting kill to
it."
(setcar kill-ring
(if before-p
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
to make one entry in the kill ring."
(interactive "r")
(cond
+
+ ;; 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))
+ (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)))
;; 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)
(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 transient-mark-mode mark-active
+ (progn
+ (message "foo")
+ (setq mark-active nil)
+ (run-hooks 'deactivate-mark-hook))))
+ (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.
(save-excursion
(insert-buffer-substring oldbuf start end)))))
\f
-(defun mark ()
- "Return this buffer's mark value as integer, or nil if no mark.
+(defun mark (&optional force)
+ "Return this buffer's mark value as integer, or nil if no active mark now.
+If optional argument FORCE is non-nil, access the mark value
+even if the mark is not currently active.
+
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)
+ (marker-position (mark-marker))
+ (error "The mark is not currently active")))
(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)))."
+ (setq mark-active t)
+ (run-hooks 'activate-mark-hook)
(set-marker (mark-marker) pos (current-buffer)))
(defvar mark-ring nil
(defun set-mark-command (arg)
"Set mark at where point is, or jump to mark.
-With no prefix argument, set mark, and push previous mark on mark ring.
-With argument, jump to mark, and pop into mark off the mark ring.
+With no prefix argument, set mark, and push old mark position on mark ring.
+With argument, jump to mark, and pop a new position for mark off the ring.
Novice Emacs Lisp programmers often try to use the mark for the wrong
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))
+ (if transient-mark-mode
+ (setq mark-active nil))
(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, changing the buffer \"deactivates\" the mark.
+While the mark is active, the region is highlighted."
+ (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)
Then it does not try to move vertically.
If you are thinking of using this in a Lisp program, consider using
-`forward-line' with negative argument instead.. It is usually easier
+`forward-line' with a negative argument instead. It is usually easier
to use and more reliable (no dependence on goal column, etc.)."
(interactive "p")
(line-move (- arg))
This means moving to the end of each line moved onto.
The beginning of a blank line does not count as the end of a line.")
-(make-variable-buffer-local
- (defvar goal-column nil
- "*Semipermanent goal column for vertical motion, as set by \\[set-goal-column], or nil."))
+(defvar goal-column nil
+ "*Semipermanent goal column for vertical motion, as set by \\[set-goal-column], or nil.")
+(make-variable-buffer-local 'goal-column)
(defvar temporary-goal-column 0
"Current goal column for vertical motion.
(move-to-column (or goal-column temporary-goal-column))
nil)
+;;; Many people have said they rarely use this feature, and often type
+;;; it by accident. Maybe it shouldn't even be on a key.
+(put 'set-goal-column 'disabled t)
(defun set-goal-column (arg)
"Set the current horizontal position as a goal for \\[next-line] and \\[previous-line].
Those commands will move to this position in the line moved to
rather than trying to keep the same horizontal position.
With a non-nil argument, clears out the goal column
-so that \\[next-line] and \\[previous-line] resume vertical motion."
+so that \\[next-line] and \\[previous-line] resume vertical motion.
+The goal column is stored in the variable `goal-column'."
(interactive "P")
(if arg
(progn
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* ((min (window-hscroll))
+ (max (- (+ min (window-width)) 2))
+ (here (current-column))
+ (delta (if (zerop hscroll-step) (/ (window-width) 2) hscroll-step))
+ )
+ (if (< here min)
+ (scroll-right (max 0 (+ (- min here) delta)))
+ (if (>= here max)
+ (scroll-left (- (- here min) delta))
+ ))))
+
+;; 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
\f
(defconst comment-column 32
"*Column to indent right-margin comments to.
-Setting this variable automatically makes it local to the current buffer.")
+Setting this variable automatically makes it local to the current buffer.
+Each mode establishes a different default value for this variable; you
+can the value for a particular mode using that mode's hook.")
(make-variable-buffer-local 'comment-column)
(defconst comment-start nil
"*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.
(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."
;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)
+ (and transient-mark-mode mark-active
+ (progn
+ (setq mark-active nil)
+ (run-hooks 'deactivate-mark-hook)))
(signal 'quit nil))
(define-key global-map "\C-g" 'keyboard-quit)
HCoop / bpt / emacs.git / blobdiff