;;; simple.el --- basic editing commands for Emacs
;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
-;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
+;; Package: emacs
;; This file is part of GNU Emacs.
;;; Code:
+;; This is for lexical-let in apply-partially.
+(eval-when-compile (require 'cl))
+
(declare-function widget-convert "wid-edit" (type &rest args))
(declare-function shell-mode "shell" ())
(defvar compilation-current-error)
(defcustom idle-update-delay 0.5
- "*Idle time delay before updating various things on the screen.
+ "Idle time delay before updating various things on the screen.
Various Emacs features that update auxiliary information when point moves
wait this many seconds after Emacs becomes idle before doing an update."
:type 'number
(car list)))
(defun last-buffer (&optional buffer visible-ok frame)
- "Return the last non-hidden displayable buffer in the buffer list.
-If BUFFER is non-nil, last-buffer will ignore that buffer.
+ "Return the last buffer in FRAME's buffer list.
+If BUFFER is the last buffer, return the preceding buffer instead.
Buffers not visible in windows are preferred to visible buffers,
unless optional argument VISIBLE-OK is non-nil.
-If the optional third argument FRAME is non-nil, use that frame's
-buffer list instead of the selected frame's buffer list.
-If no other buffer exists, the buffer `*scratch*' is returned."
+Optional third argument FRAME nil or omitted means use the
+selected frame's buffer list.
+If no such buffer exists, return the buffer `*scratch*', creating
+it if necessary."
(setq frame (or frame (selected-frame)))
(or (get-next-valid-buffer (nreverse (buffer-list frame))
buffer visible-ok frame)
- (progn
- (set-buffer-major-mode (get-buffer-create "*scratch*"))
- (get-buffer "*scratch*"))))
+ (get-buffer "*scratch*")
+ (let ((scratch (get-buffer-create "*scratch*")))
+ (set-buffer-major-mode scratch)
+ scratch)))
+
(defun next-buffer ()
"Switch to the next buffer in cyclic order."
(interactive)
:version "22.1")
(defcustom next-error-highlight 0.5
- "*Highlighting of locations in selected source buffers.
+ "Highlighting of locations in selected source buffers.
If a number, highlight the locus in `next-error' face for the given time
in seconds, or until the next command is executed.
If t, highlight the locus until the next command is executed, or until
:version "22.1")
(defcustom next-error-highlight-no-select 0.5
- "*Highlighting of locations in `next-error-no-select'.
+ "Highlighting of locations in `next-error-no-select'.
If number, highlight the locus in `next-error' face for given time in seconds.
If t, highlight the locus indefinitely until some other locus replaces it.
If nil, don't highlight the locus in the source buffer.
:version "22.1")
(defcustom next-error-recenter nil
- "*Display the line in the visited source file recentered as specified.
+ "Display the line in the visited source file recentered as specified.
If non-nil, the value is passed directly to `recenter'."
:type '(choice (integer :tag "Line to recenter to")
(const :tag "Center of window" (4))
:version "23.1")
(defcustom next-error-hook nil
- "*List of hook functions run by `next-error' after visiting source file."
+ "List of hook functions run by `next-error' after visiting source file."
:type 'hook
:group 'next-error)
(defvar next-error-highlight-timer nil)
(defvar next-error-overlay-arrow-position nil)
-(put 'next-error-overlay-arrow-position 'overlay-arrow-string "=>")
+(put 'next-error-overlay-arrow-position 'overlay-arrow-string (purecopy "=>"))
(add-to-list 'overlay-arrow-variable-list 'next-error-overlay-arrow-position)
(defvar next-error-last-buffer nil
Major modes providing compile-like functionality should set this variable
to indicate to `next-error' that this is a candidate buffer and how
to navigate in it.")
-
(make-variable-buffer-local 'next-error-function)
+(defvar next-error-move-function nil
+ "Function to use to move to an error locus.
+It takes two arguments, a buffer position in the error buffer
+and a buffer position in the error locus buffer.
+The buffer for the error locus should already be current.
+nil means use goto-char using the second argument position.")
+(make-variable-buffer-local 'next-error-move-function)
+
(defsubst next-error-buffer-p (buffer
&optional avoid-current
extra-test-inclusive
(interactive "p")
(next-error-no-select (- (or n 1))))
-;;; Internal variable for `next-error-follow-mode-post-command-hook'.
+;; Internal variable for `next-error-follow-mode-post-command-hook'.
(defvar next-error-follow-last-line nil)
(define-minor-mode next-error-follow-minor-mode
(add-hook 'post-command-hook 'next-error-follow-mode-post-command-hook nil t)
(make-local-variable 'next-error-follow-last-line)))
-;;; Used as a `post-command-hook' by `next-error-follow-mode'
-;;; for the *Compilation* *grep* and *Occur* buffers.
+;; Used as a `post-command-hook' by `next-error-follow-mode'
+;; for the *Compilation* *grep* and *Occur* buffers.
(defun next-error-follow-mode-post-command-hook ()
(unless (equal next-error-follow-last-line (line-number-at-pos))
(setq next-error-follow-last-line (line-number-at-pos))
Other major modes are defined by comparison with this one."
(interactive)
(kill-all-local-variables)
- (unless delay-mode-hooks
- (run-hooks 'after-change-major-mode-hook)))
+ (run-mode-hooks 'fundamental-mode-hook))
;; Special major modes to view specially formatted data rather than files.
(define-key map "<" 'beginning-of-buffer)
(define-key map "g" 'revert-buffer)
map))
-
+
(put 'special-mode 'mode-class 'special)
(define-derived-mode special-mode nil "Special"
"Parent major mode from which special major modes should inherit."
(setq buffer-read-only t))
+;; Major mode meant to be the parent of programming modes.
+
+(defvar prog-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [?\C-\M-q] 'prog-indent-sexp)
+ map)
+ "Keymap used for programming modes.")
+
+(defun prog-indent-sexp ()
+ "Indent the expression after point."
+ (interactive)
+ (let ((start (point))
+ (end (save-excursion (forward-sexp 1) (point))))
+ (indent-region start end nil)))
+
+(define-derived-mode prog-mode fundamental-mode "Prog"
+ "Major mode for editing programming language source code."
+ (set (make-local-variable 'require-final-newline) mode-require-final-newline)
+ (set (make-local-variable 'parse-sexp-ignore-comments) t))
+
;; Making and deleting lines.
-(defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard)))
+(defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard))
+ "Propertized string representing a hard newline character.")
(defun newline (&optional arg)
"Insert a newline, and move to left margin of the new line if it's blank.
(beforepos (point)))
(if flag (backward-char 1))
;; Call self-insert so that auto-fill, abbrev expansion etc. happens.
- ;; Set last-command-char to tell self-insert what to insert.
- (let ((last-command-char ?\n)
+ ;; Set last-command-event to tell self-insert what to insert.
+ (let ((last-command-event ?\n)
;; Don't auto-fill if we have a numeric argument.
;; Also not if flag is true (it would fill wrong line);
;; there is no need to since we're at BOL.
(defun quoted-insert (arg)
"Read next input character and insert it.
This is useful for inserting control characters.
+With argument, insert ARG copies of the character.
If the first character you type after this command is an octal digit,
you should type a sequence of octal digits which specify a character code.
digits are interpreted as a character code. This is intended to be
useful for editing binary files."
(interactive "*p")
- (let* ((char (let (translation-table-for-input input-method-function)
- (if (or (not overwrite-mode)
- (eq overwrite-mode 'overwrite-mode-binary))
- (read-quoted-char)
- (read-char)))))
+ (let* ((char
+ ;; Avoid "obsolete" warnings for translation-table-for-input.
+ (with-no-warnings
+ (let (translation-table-for-input input-method-function)
+ (if (or (not overwrite-mode)
+ (eq overwrite-mode 'overwrite-mode-binary))
+ (read-quoted-char)
+ (read-char))))))
;; This used to assume character codes 0240 - 0377 stand for
;; characters in some single-byte character set, and converted them
;; to Emacs characters. But in 23.1 this feature is deprecated
(overlay-recenter (point))
(recenter -3))))
+(defcustom delete-active-region t
+ "Whether single-char deletion commands delete an active region.
+This has an effect only if Transient Mark mode is enabled, and
+affects `delete-forward-char' and `delete-backward-char', though
+not `delete-char'.
+
+If the value is the symbol `kill', the active region is killed
+instead of deleted."
+ :type '(choice (const :tag "Delete active region" t)
+ (const :tag "Kill active region" kill)
+ (const :tag "Do ordinary deletion" nil))
+ :group 'editing
+ :version "24.1")
+
+(defun delete-backward-char (n &optional killflag)
+ "Delete the previous N characters (following if N is negative).
+If Transient Mark mode is enabled, the mark is active, and N is 1,
+delete the text in the region and deactivate the mark instead.
+To disable this, set `delete-active-region' to nil.
+
+Optional second arg KILLFLAG, if non-nil, means to kill (save in
+kill ring) instead of delete. Interactively, N is the prefix
+arg, and KILLFLAG is set if N is explicitly specified.
+
+In Overwrite mode, single character backward deletion may replace
+tabs with spaces so as to back over columns, unless point is at
+the end of the line."
+ (interactive "p\nP")
+ (unless (integerp n)
+ (signal 'wrong-type-argument (list 'integerp n)))
+ (cond ((and (use-region-p)
+ delete-active-region
+ (= n 1))
+ ;; If a region is active, kill or delete it.
+ (if (eq delete-active-region 'kill)
+ (kill-region (region-beginning) (region-end))
+ (delete-region (region-beginning) (region-end))))
+ ;; In Overwrite mode, maybe untabify while deleting
+ ((null (or (null overwrite-mode)
+ (<= n 0)
+ (memq (char-before) '(?\t ?\n))
+ (eobp)
+ (eq (char-after) ?\n)))
+ (let* ((ocol (current-column))
+ (val (delete-char (- n) killflag)))
+ (save-excursion
+ (insert-char ?\s (- ocol (current-column)) nil))))
+ ;; Otherwise, do simple deletion.
+ (t (delete-char (- n) killflag))))
+
+(defun delete-forward-char (n &optional killflag)
+ "Delete the following N characters (previous if N is negative).
+If Transient Mark mode is enabled, the mark is active, and N is 1,
+delete the text in the region and deactivate the mark instead.
+To disable this, set `delete-active-region' to nil.
+
+Optional second arg KILLFLAG non-nil means to kill (save in kill
+ring) instead of delete. Interactively, N is the prefix arg, and
+KILLFLAG is set if N was explicitly specified."
+ (interactive "p\nP")
+ (unless (integerp n)
+ (signal 'wrong-type-argument (list 'integerp n)))
+ (cond ((and (use-region-p)
+ delete-active-region
+ (= n 1))
+ ;; If a region is active, kill or delete it.
+ (if (eq delete-active-region 'kill)
+ (kill-region (region-beginning) (region-end))
+ (delete-region (region-beginning) (region-end))))
+ ;; Otherwise, do simple deletion.
+ (t (delete-char n killflag))))
+
(defun mark-whole-buffer ()
"Put point at beginning and mark at end of buffer.
You probably should not use this function in Lisp programs;
;; Counting lines, one way or another.
-(defun goto-line (arg &optional buffer)
- "Goto line ARG, counting from line 1 at beginning of buffer.
-Normally, move point in the current buffer, and leave mark at previous
-position. With just \\[universal-argument] as argument, move point
-in the most recently displayed other buffer, and switch to it.
-When called from Lisp code, the optional argument BUFFER specifies
-a buffer to switch to.
+(defun goto-line (line &optional buffer)
+ "Goto LINE, counting from line 1 at beginning of buffer.
+Normally, move point in the current buffer, and leave mark at the
+previous position. With just \\[universal-argument] as argument,
+move point in the most recently selected other buffer, and switch to it.
-If there's a number in the buffer at point, it is the default for ARG."
+If there's a number in the buffer at point, it is the default for LINE.
+
+This function is usually the wrong thing to use in a Lisp program.
+What you probably want instead is something like:
+ (goto-char (point-min)) (forward-line (1- N))
+If at all possible, an even better solution is to use char counts
+rather than line counts."
(interactive
(if (and current-prefix-arg (not (consp current-prefix-arg)))
(list (prefix-numeric-value current-prefix-arg))
;; Move to the specified line number in that buffer.
(save-restriction
(widen)
- (goto-char 1)
+ (goto-char (point-min))
(if (eq selective-display t)
- (re-search-forward "[\n\C-m]" nil 'end (1- arg))
- (forward-line (1- arg)))))
+ (re-search-forward "[\n\C-m]" nil 'end (1- line))
+ (forward-line (1- line)))))
(defun count-lines-region (start end)
"Print number of lines and characters in the region."
encoded encoding-msg display-prop under-display)
(if (or (not coding)
(eq (coding-system-type coding) t))
- (setq coding default-buffer-file-coding-system))
+ (setq coding (default-value 'buffer-file-coding-system)))
(if (eq (char-charset char) 'eight-bit)
(setq encoding-msg
(format "(%d, #o%o, #x%x, raw-byte)" char char char))
(defvar minibuffer-completing-symbol nil
"Non-nil means completing a Lisp symbol in the minibuffer.")
+(defvar minibuffer-default nil
+ "The current default value or list of default values in the minibuffer.
+The functions `read-from-minibuffer' and `completing-read' bind
+this variable locally.")
+
(defcustom eval-expression-print-level 4
"Value for `print-level' while printing value in `eval-expression'.
A value of nil means no limit."
&optional eval-expression-insert-value)
"Evaluate EVAL-EXPRESSION-ARG and print value in the echo area.
Value is also consed on to front of the variable `values'.
-Optional argument EVAL-EXPRESSION-INSERT-VALUE, if non-nil, means
-insert the result into the current buffer instead of printing it in
-the echo area.
+Optional argument EVAL-EXPRESSION-INSERT-VALUE non-nil (interactively,
+with prefix argument) means insert the result into the current buffer
+instead of printing it in the echo area. Truncates long output
+according to the value of the variables `eval-expression-print-length'
+and `eval-expression-print-level'.
If `eval-expression-debug-on-error' is non-nil, which is the default,
this command arranges for all errors to enter the debugger."
A complex command is one which used the minibuffer.
The command is placed in the minibuffer as a Lisp form for editing.
The result is executed, repeating the command as changed.
-If the command has been changed or is not the most recent previous command
-it is added to the front of the command history.
-You can use the minibuffer history commands \\<minibuffer-local-map>\\[next-history-element] and \\[previous-history-element]
+If the command has been changed or is not the most recent previous
+command it is added to the front of the command history.
+You can use the minibuffer history commands \
+\\<minibuffer-local-map>\\[next-history-element] and \\[previous-history-element]
to get different commands to edit and resubmit."
(interactive "p")
(let ((elt (nth (1- arg) command-history))
(if command-history
(error "Argument %d is beyond length of command history" arg)
(error "There are no previous complex commands to repeat")))))
+
+(defun read-extended-command ()
+ "Read command name to invoke in `execute-extended-command'."
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (set (make-local-variable 'minibuffer-default-add-function)
+ (lambda ()
+ ;; Get a command name at point in the original buffer
+ ;; to propose it after M-n.
+ (with-current-buffer (window-buffer (minibuffer-selected-window))
+ (and (commandp (function-called-at-point))
+ (format "%S" (function-called-at-point)))))))
+ ;; Read a string, completing from and restricting to the set of
+ ;; all defined commands. Don't provide any initial input.
+ ;; Save the command read on the extended-command history list.
+ (completing-read
+ (concat (cond
+ ((eq current-prefix-arg '-) "- ")
+ ((and (consp current-prefix-arg)
+ (eq (car current-prefix-arg) 4)) "C-u ")
+ ((and (consp current-prefix-arg)
+ (integerp (car current-prefix-arg)))
+ (format "%d " (car current-prefix-arg)))
+ ((integerp current-prefix-arg)
+ (format "%d " current-prefix-arg)))
+ ;; This isn't strictly correct if `execute-extended-command'
+ ;; is bound to anything else (e.g. [menu]).
+ ;; It could use (key-description (this-single-command-keys)),
+ ;; but actually a prompt other than "M-x" would be confusing,
+ ;; because "M-x" is a well-known prompt to read a command
+ ;; and it serves as a shorthand for "Extended command: ".
+ "M-x ")
+ obarray 'commandp t nil 'extended-command-history)))
+
\f
(defvar minibuffer-history nil
"Default minibuffer history list.
(constrain-to-field nil (point-max)))
(defcustom minibuffer-history-case-insensitive-variables nil
- "*Minibuffer history variables for which matching should ignore case.
+ "Minibuffer history variables for which matching should ignore case.
If a history variable is a member of this list, then the
\\[previous-matching-history-element] and \\[next-matching-history-element]\
commands ignore case when searching it, regardless of `case-fold-search'."
(defvar minibuffer-temporary-goal-position nil)
(defvar minibuffer-default-add-function 'minibuffer-default-add-completions
- "Function run by `goto-history-element' before consuming `minibuffer-default'.
-This is useful to dynamically add more elements to the list `minibuffer-default'
+ "Function run by `goto-history-element' before consuming default values.
+This is useful to dynamically add more elements to the list of default values
when `goto-history-element' reaches the end of this list.
Before calling this function `goto-history-element' sets the variable
`minibuffer-default-add-done' to t, so it will call this function only
"Return a list of all completions without the default value.
This function is used to add all elements of the completion table to
the end of the list of defaults just after the default value."
- (interactive)
(let ((def minibuffer-default)
(all (all-completions ""
minibuffer-completion-table
- minibuffer-completion-predicate
- t)))
+ minibuffer-completion-predicate)))
(if (listp def)
(append def all)
(cons def (delete def all)))))
(message "")))
(defun minibuffer-history-isearch-wrap ()
- "Wrap the minibuffer history search when search is failed.
+ "Wrap the minibuffer history search when search fails.
Move point to the first history element for a forward search,
or to the last history element for a backward search."
(unless isearch-word
(defun minibuffer-history-isearch-pop-state (cmd hist-pos)
"Restore the minibuffer history search state.
-Go to the history element by the absolute history position `hist-pos'."
+Go to the history element by the absolute history position HIST-POS."
(goto-history-element hist-pos))
\f
;Put this on C-x u, so we can force that rather than C-_ into startup msg
-(defalias 'advertised-undo 'undo)
+(define-obsolete-function-alias 'advertised-undo 'undo "23.2")
(defconst undo-equiv-table (make-hash-table :test 'eq :weakness t)
"Table mapping redo records to the corresponding undo one.
(defun undo (&optional arg)
"Undo some previous changes.
Repeat this command to undo more changes.
-A numeric argument serves as a repeat count.
+A numeric ARG 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 \\[universal-argument]
;; In the ordinary case (not within a region), map the redo
;; record to the following undos.
;; I don't know how to do that in the undo-in-region case.
- (puthash buffer-undo-list
- (if undo-in-region t pending-undo-list)
- undo-equiv-table)
+ (let ((list buffer-undo-list))
+ ;; Strip any leading undo boundaries there might be, like we do
+ ;; above when checking.
+ (while (eq (car list) nil)
+ (setq list (cdr list)))
+ (puthash list (if undo-in-region t 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)
(defun undo-only (&optional arg)
"Undo some previous changes.
Repeat this command to undo more changes.
-A numeric argument serves as a repeat count.
+A numeric ARG serves as a repeat count.
Contrary to `undo', this will not redo a previous undo."
(interactive "*p")
(let ((undo-no-redo t)) (undo arg)))
(error (concat "No further undo information"
(and undo-in-region " for region"))))
(let ((undo-in-progress t))
+ ;; Note: The following, while pulling elements off
+ ;; `pending-undo-list' will call primitive change functions which
+ ;; will push more elements onto `buffer-undo-list'.
(setq pending-undo-list (primitive-undo n pending-undo-list))
(if (null pending-undo-list)
(setq pending-undo-list t))))
probably due to a bug and you should report it.
You can disable the popping up of this buffer by adding the entry
-\(undo discard-info) to the user option `warning-suppress-types'.\n")
+\(undo discard-info) to the user option `warning-suppress-types',
+which is defined in the `warnings' library.\n")
:warning)
(setq buffer-undo-list nil)
t))
Maximum length of the history list is determined by the value
of `history-length', which see.")
-(defvar shell-command-switch "-c"
+(defvar shell-command-switch (purecopy "-c")
"Switch used to have the shell execute its command line argument.")
(defvar shell-command-default-error-buffer nil
stdout will be intermixed in the output stream.")
(declare-function mailcap-file-default-commands "mailcap" (files))
+(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep))
(defun minibuffer-default-add-shell-commands ()
- "Return a list of all commands associted with the current file.
-This function is used to add all related commands retieved by `mailcap'
+ "Return a list of all commands associated with the current file.
+This function is used to add all related commands retrieved by `mailcap'
to the end of the list of defaults just after the default value."
(interactive)
(let* ((filename (if (listp minibuffer-default)
(append minibuffer-default commands)
(cons minibuffer-default commands))))
+(defvar shell-delimiter-argument-list)
+(defvar shell-file-name-chars)
+(defvar shell-file-name-quote-list)
+
(defun minibuffer-complete-shell-command ()
"Dynamically complete shell command at point."
(interactive)
(require 'shell)
- (run-hook-with-args-until-success 'shell-dynamic-complete-functions))
+ (let ((comint-delimiter-argument-list shell-delimiter-argument-list)
+ (comint-file-name-chars shell-file-name-chars)
+ (comint-file-name-quote-list shell-file-name-quote-list))
+ (run-hook-with-args-until-success 'shell-dynamic-complete-functions)))
(defvar minibuffer-local-shell-command-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map minibuffer-local-map)
(define-key map "\t" 'minibuffer-complete-shell-command)
map)
- "Keymap used for completiing shell commands in minibufffer.")
+ "Keymap used for completing shell commands in minibuffer.")
(defun read-shell-command (prompt &optional initial-contents hist &rest args)
"Read a shell command from the minibuffer.
(or hist 'shell-command-history)
args)))
+(defun async-shell-command (command &optional output-buffer error-buffer)
+ "Execute string COMMAND asynchronously in background.
+
+Like `shell-command' but if COMMAND doesn't end in ampersand, adds `&'
+surrounded by whitespace and executes the command asynchronously.
+The output appears in the buffer `*Async Shell Command*'.
+
+In Elisp, you will often be better served by calling `start-process'
+directly, since it offers more control and does not impose the use of a
+shell (with its need to quote arguments)."
+ (interactive
+ (list
+ (read-shell-command "Async shell command: " nil nil
+ (and buffer-file-name
+ (file-relative-name buffer-file-name)))
+ current-prefix-arg
+ shell-command-default-error-buffer))
+ (unless (string-match "&[ \t]*\\'" command)
+ (setq command (concat command " &")))
+ (shell-command command output-buffer error-buffer))
+
(defun shell-command (command &optional output-buffer error-buffer)
"Execute string COMMAND in inferior shell; display output, if any.
With prefix argument, insert the COMMAND's output at point.
Output*' even though that buffer is not automatically displayed.
To specify a coding system for converting non-ASCII characters
-in the shell command output, use \\[universal-coding-system-argument]
+in the shell command output, use \\[universal-coding-system-argument] \
before this command.
Noninteractive callers can specify coding systems by binding
If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
If OUTPUT-BUFFER is not a buffer and not nil,
insert output in current buffer. (This cannot be done asynchronously.)
-In either case, the output is inserted after point (leaving mark after it).
+In either case, the buffer is first erased, and the output is
+inserted after point (leaving mark after it).
If the command terminates without error, but generates output,
and you did not specify \"insert it in the current buffer\",
the output can be displayed in the echo area or in its buffer.
If the output is short enough to display in the echo area
\(determined by the variable `max-mini-window-height' if
-`resize-mini-windows' is non-nil), it is shown there. Otherwise,
-the buffer containing the output is displayed.
+`resize-mini-windows' is non-nil), it is shown there.
+Otherwise,the buffer containing the output is displayed.
If there is output and an error, and you did not specify \"insert it
in the current buffer\", a message about the error goes at the end
or buffer name to which to direct the command's standard error output.
If it is nil, error output is mingled with regular output.
In an interactive call, the variable `shell-command-default-error-buffer'
-specifies the value of ERROR-BUFFER."
+specifies the value of ERROR-BUFFER.
+
+In Elisp, you will often be better served by calling `call-process' or
+`start-process' directly, since it offers more control and does not impose
+the use of a shell (with its need to quote arguments)."
(interactive
(list
(read-shell-command "Shell command: " nil nil
- (and buffer-file-name
- (file-relative-name buffer-file-name)))
+ (let ((filename
+ (cond
+ (buffer-file-name)
+ ((eq major-mode 'dired-mode)
+ (dired-get-filename nil t)))))
+ (and filename (file-relative-name filename))))
current-prefix-arg
shell-command-default-error-buffer))
;; Look for a handler in case default-directory is a remote file name.
(setq mode-line-process '(":%s"))
(require 'shell) (shell-mode)
(set-process-sentinel proc 'shell-command-sentinel)
+ ;; Use the comint filter for proper handling of carriage motion
+ ;; (see `comint-inhibit-carriage-motion'),.
+ (set-process-filter proc 'comint-output-filter)
))
+ ;; Otherwise, command is executed synchronously.
(shell-command-on-region (point) (point) command
output-buffer nil error-buffer)))))))
;; Clear the output buffer, then run the command with
;; output there.
(let ((directory default-directory))
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(setq buffer-read-only nil)
(if (not output-buffer)
(setq default-directory directory))
(when stderr-file (delete-file stderr-file))
(when lc (delete-file lc)))))
+(defvar process-file-side-effects t
+ "Whether a call of `process-file' changes remote files.
+
+Per default, this variable is always set to `t', meaning that a
+call of `process-file' could potentially change any file on a
+remote host. When set to `nil', a file handler could optimize
+its behaviour with respect to remote file attributes caching.
+
+This variable should never be changed by `setq'. Instead of, it
+shall be set only by let-binding.")
+
(defun start-file-process (name buffer program &rest program-args)
"Start a program in a subprocess. Return the process object for it.
the working directory of the process.
PROGRAM and PROGRAM-ARGS might be file names. They are not
-objects of file handler invocation."
+objects of file handler invocation. File handlers might not
+support pty association, if PROGRAM is nil."
(let ((fh (find-file-name-handler default-directory 'start-file-process)))
(if fh (apply fh 'start-file-process name buffer program program-args)
(apply 'start-process name buffer program program-args))))
-
\f
(defvar universal-argument-map
(let ((map (make-sparse-keymap)))
"Part of the numeric argument for the next command.
\\[universal-argument] following digits or minus sign ends the argument."
(interactive "P")
- (let* ((char (if (integerp last-command-char)
- last-command-char
- (get last-command-char 'ascii-character)))
+ (let* ((char (if (integerp last-command-event)
+ last-command-event
+ (get last-command-event 'ascii-character)))
(digit (- (logand char ?\177) ?0)))
(cond ((integerp arg)
(setq prefix-arg (+ (* arg 10)
(reset-this-command-lengths)
(restore-overriding-map))
\f
+;; This function is here rather than in subr.el because it uses CL.
+(defmacro with-wrapper-hook (var args &rest body)
+ "Run BODY wrapped with the VAR hook.
+VAR is a special hook: its functions are called with a first argument
+which is the \"original\" code (the BODY), so the hook function can wrap
+the original function, or call it any number of times (including not calling
+it at all). This is similar to an `around' advice.
+VAR is normally a symbol (a variable) in which case it is treated like
+a hook, with a buffer-local and a global part. But it can also be an
+arbitrary expression.
+ARGS is a list of variables which will be passed as additional arguments
+to each function, after the initial argument, and which the first argument
+expects to receive when called."
+ (declare (indent 2) (debug t))
+ ;; We need those two gensyms because CL's lexical scoping is not available
+ ;; for function arguments :-(
+ (let ((funs (make-symbol "funs"))
+ (global (make-symbol "global"))
+ (argssym (make-symbol "args")))
+ ;; Since the hook is a wrapper, the loop has to be done via
+ ;; recursion: a given hook function will call its parameter in order to
+ ;; continue looping.
+ `(labels ((runrestofhook (,funs ,global ,argssym)
+ ;; `funs' holds the functions left on the hook and `global'
+ ;; holds the functions left on the global part of the hook
+ ;; (in case the hook is local).
+ (lexical-let ((funs ,funs)
+ (global ,global))
+ (if (consp funs)
+ (if (eq t (car funs))
+ (runrestofhook
+ (append global (cdr funs)) nil ,argssym)
+ (apply (car funs)
+ (lambda (&rest ,argssym)
+ (runrestofhook (cdr funs) global ,argssym))
+ ,argssym))
+ ;; Once there are no more functions on the hook, run
+ ;; the original body.
+ (apply (lambda ,args ,@body) ,argssym)))))
+ (runrestofhook ,var
+ ;; The global part of the hook, if any.
+ ,(if (symbolp var)
+ `(if (local-variable-p ',var)
+ (default-value ',var)))
+ (list ,@args)))))
+
+(defvar filter-buffer-substring-functions nil
+ "Wrapper hook around `filter-buffer-substring'.
+The functions on this special hook are called with 4 arguments:
+ NEXT-FUN BEG END DELETE
+NEXT-FUN is a function of 3 arguments (BEG END DELETE)
+that performs the default operation. The other 3 arguments are like
+the ones passed to `filter-buffer-substring'.")
+
(defvar buffer-substring-filters nil
"List of filter functions for `filter-buffer-substring'.
Each function must accept a single argument, a string, and return
return value of `filter-buffer-substring'.
If this variable is nil, no filtering is performed.")
+(make-obsolete-variable 'buffer-substring-filters
+ 'filter-buffer-substring-functions "24.1")
-(defun filter-buffer-substring (beg end &optional delete noprops)
+(defun filter-buffer-substring (beg end &optional delete)
"Return the buffer substring between BEG and END, after filtering.
-The buffer substring is passed through each of the filter
-functions in `buffer-substring-filters', and the value from the
-last filter function is returned. If `buffer-substring-filters'
-is nil, the buffer substring is returned unaltered.
+The filtering is performed by `filter-buffer-substring-functions'.
If DELETE is non-nil, the text between BEG and END is deleted
from the buffer.
-If NOPROPS is non-nil, final string returned does not include
-text properties, while the string passed to the filters still
-includes text properties from the buffer text.
-
-Point is temporarily set to BEG before calling
-`buffer-substring-filters', in case the functions need to know
-where the text came from.
-
This function should be used instead of `buffer-substring',
`buffer-substring-no-properties', or `delete-and-extract-region'
when you want to allow filtering to take place. For example,
-major or minor modes can use `buffer-substring-filters' to
+major or minor modes can use `filter-buffer-substring-functions' to
extract characters that are special to a buffer, and should not
be copied into other buffers."
- (cond
- ((or delete buffer-substring-filters)
- (save-excursion
- (goto-char beg)
- (let ((string (if delete (delete-and-extract-region beg end)
- (buffer-substring beg end))))
- (dolist (filter buffer-substring-filters)
- (setq string (funcall filter string)))
- (if noprops
- (set-text-properties 0 (length string) nil string))
- string)))
- (noprops
- (buffer-substring-no-properties beg end))
- (t
- (buffer-substring beg end))))
+ (with-wrapper-hook filter-buffer-substring-functions (beg end delete)
+ (cond
+ ((or delete buffer-substring-filters)
+ (save-excursion
+ (goto-char beg)
+ (let ((string (if delete (delete-and-extract-region beg end)
+ (buffer-substring beg end))))
+ (dolist (filter buffer-substring-filters)
+ (setq string (funcall filter string)))
+ string)))
+ (t
+ (buffer-substring beg end)))))
;;;; Window system cut and paste hooks.
should put this string in the kill ring as the latest kill.
This function may also return a list of strings if the window
-system supports multiple selections. The first string will be
+system supports multiple selections. The first string will be
used as the pasted text, but the other will be placed in the
kill ring for easy access via `yank-pop'.
ring directly.")
(defcustom kill-ring-max 60
- "*Maximum length of kill ring before oldest elements are thrown away."
+ "Maximum length of kill ring before oldest elements are thrown away."
:type 'integer
:group 'killing)
(defvar kill-ring-yank-pointer nil
"The tail of the kill ring whose car is the last thing yanked.")
+(defcustom save-interprogram-paste-before-kill nil
+ "Save clipboard strings into kill ring before replacing them.
+When one selects something in another program to paste it into Emacs,
+but kills something in Emacs before actually pasting it,
+this selection is gone unless this variable is non-nil,
+in which case the other program's selection is saved in the `kill-ring'
+before the Emacs kill and one can still paste it using \\[yank] \\[yank-pop]."
+ :type 'boolean
+ :group 'killing
+ :version "23.2")
+
+(defcustom kill-do-not-save-duplicates nil
+ "Do not add a new string to `kill-ring' when it is the same as the last one."
+ :type 'boolean
+ :group 'killing
+ :version "23.2")
+
(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.
When a yank handler is specified, STRING must be non-empty (the yank
handler, if non-nil, is stored as a `yank-handler' text property on STRING).
+When `save-interprogram-paste-before-kill' and `interprogram-paste-function'
+are non-nil, saves the interprogram paste string(s) into `kill-ring' before
+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
(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)
- (push string kill-ring)
- (if (> (length kill-ring) kill-ring-max)
- (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)))
+ (unless (and kill-do-not-save-duplicates
+ (equal string (car kill-ring)))
+ (if (fboundp 'menu-bar-update-yank-menu)
+ (menu-bar-update-yank-menu string (and replace (car kill-ring)))))
+ (when save-interprogram-paste-before-kill
+ (let ((interprogram-paste (and interprogram-paste-function
+ (funcall interprogram-paste-function))))
+ (when interprogram-paste
+ (dolist (s (if (listp interprogram-paste)
+ (nreverse interprogram-paste)
+ (list interprogram-paste)))
+ (unless (and kill-do-not-save-duplicates
+ (equal s (car kill-ring)))
+ (push s kill-ring))))))
+ (unless (and kill-do-not-save-duplicates
+ (equal string (car kill-ring)))
+ (if (and replace kill-ring)
+ (setcar kill-ring string)
+ (push string kill-ring)
+ (if (> (length kill-ring) kill-ring-max)
+ (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil))))
(setq kill-ring-yank-pointer kill-ring)
(if interprogram-cut-function
(funcall interprogram-cut-function string (not replace))))
(defun current-kill (n &optional do-not-move)
"Rotate the yanking point by N places, and then return that kill.
-If N is zero, `interprogram-paste-function' is set, and calling it returns a
-string or list of strings, then that string (or list) is added to the front
-of the kill ring and the string (or first string in the list) is returned as
-the latest kill.
+If N is zero, `interprogram-paste-function' is set, and calling
+it returns a string or list of strings, then that string (or
+list) is added to the front of the kill ring and the string (or
+first string in the list) is returned as the latest kill.
If N is not zero, and if `yank-pop-change-selection' is
non-nil, use `interprogram-cut-function' to transfer the
;;;; Commands for manipulating the kill ring.
(defcustom kill-read-only-ok nil
- "*Non-nil means don't signal an error for killing read-only text."
+ "Non-nil means don't signal an error for killing read-only text."
:type 'boolean
:group 'killing)
(put 'text-read-only 'error-conditions
'(text-read-only buffer-read-only error))
-(put 'text-read-only 'error-message "Text is read-only")
+(put 'text-read-only 'error-message (purecopy "Text is read-only"))
(defun kill-region (beg end &optional yank-handler)
"Kill (\"cut\") text between point and mark.
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).
+Lisp programs should use this function for killing text.
+ (To delete text, use `delete-region'.)
Supply two arguments, character positions indicating the stretch of text
to be killed.
Any command that calls this function is a \"kill command\".
visual feedback indicating the extent of the region being copied."
(interactive "r")
(copy-region-as-kill beg end)
- ;; This use of interactive-p is correct
+ ;; This use of called-interactively-p is correct
;; because the code it controls just gives the user visual feedback.
- (if (interactive-p)
+ (if (called-interactively-p 'interactive)
(let ((other-end (if (= (point) beg) end beg))
(opoint (point))
;; Inhibit quitting so we can make a quit here
(defun rotate-yank-pointer (arg)
"Rotate the yanking point in the kill ring.
-With argument, rotate that many kills forward (or backward, if negative)."
+With ARG, rotate that many kills forward (or backward, if negative)."
(interactive "p")
(current-kill arg))
\f
(defun kill-forward-chars (arg)
(if (listp arg) (setq arg (car arg)))
(if (eq arg '-) (setq arg -1))
- (kill-region (point) (forward-point arg)))
+ (kill-region (point) (+ (point) arg)))
;; Internal subroutine of backward-delete-char
(defun kill-backward-chars (arg)
(if (listp arg) (setq arg (car arg)))
(if (eq arg '-) (setq arg -1))
- (kill-region (point) (forward-point (- arg))))
+ (kill-region (point) (- (point) arg)))
(defcustom backward-delete-char-untabify-method 'untabify
- "*The method for untabifying when deleting backward.
+ "The method for untabifying when deleting backward.
Can be `untabify' -- turn a tab to many spaces, then delete one space;
`hungry' -- delete all whitespace, both tabs and spaces;
`all' -- delete all whitespace, including tabs, spaces and newlines;
killp))
(defun zap-to-char (arg char)
- "Kill up to and including ARG'th occurrence of CHAR.
+ "Kill up to and including ARGth occurrence of CHAR.
Case is ignored if `case-fold-search' is non-nil in the current buffer.
Goes backward if ARG is negative; error if CHAR not found."
(interactive "p\ncZap to char: ")
- (if (char-table-p translation-table-for-input)
- (setq char (or (aref translation-table-for-input char) char)))
+ ;; Avoid "obsolete" warnings for translation-table-for-input.
+ (with-no-warnings
+ (if (char-table-p translation-table-for-input)
+ (setq char (or (aref translation-table-for-input char) char))))
(kill-region (point) (progn
(search-forward (char-to-string char) nil nil arg)
; (goto-char (if (> arg 0) (1- (point)) (1+ (point))))
;; kill-line and its subroutines.
(defcustom kill-whole-line nil
- "*If non-nil, `kill-line' with no arg at beg of line kills the whole line."
+ "If non-nil, `kill-line' with no arg at beg of line kills the whole line."
:type 'boolean
:group 'killing)
(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.
+With prefix argument ARG, kill that many lines from point.
Negative arguments kill lines backward.
With zero argument, kills the text before point on the current line.
(defun kill-whole-line (&optional arg)
"Kill current line.
-With prefix arg, kill that many lines starting from the current line.
-If arg is negative, kill backward. Also kill the preceding newline.
+With prefix ARG, kill that many lines starting from the current line.
+If ARG is negative, kill backward. Also kill the preceding newline.
\(This is meant to make \\[repeat] work well with negative arguments.\)
-If arg is zero, kill current line but exclude the trailing newline."
+If ARG is zero, kill current line but exclude the trailing newline."
(interactive "p")
+ (or arg (setq arg 1))
(if (and (> arg 0) (eobp) (save-excursion (forward-visible-line 0) (eobp)))
(signal 'end-of-buffer nil))
(if (and (< arg 0) (bobp) (save-excursion (end-of-visible-line) (bobp)))
(interactive
(list (read-buffer "Append to buffer: " (other-buffer (current-buffer) t))
(region-beginning) (region-end)))
- (let ((oldbuf (current-buffer)))
+ (let* ((oldbuf (current-buffer))
+ (append-to (get-buffer-create buffer))
+ (windows (get-buffer-window-list append-to t t))
+ point)
(save-excursion
- (let* ((append-to (get-buffer-create buffer))
- (windows (get-buffer-window-list append-to t t))
- point)
- (set-buffer append-to)
- (setq point (point))
- (barf-if-buffer-read-only)
- (insert-buffer-substring oldbuf start end)
- (dolist (window windows)
- (when (= (window-point window) point)
- (set-window-point window (point))))))))
+ (with-current-buffer append-to
+ (setq point (point))
+ (barf-if-buffer-read-only)
+ (insert-buffer-substring oldbuf start end)
+ (dolist (window windows)
+ (when (= (window-point window) point)
+ (set-window-point window (point))))))))
(defun prepend-to-buffer (buffer start end)
"Prepend to specified buffer the text of the region.
START and END specify the portion of the current buffer to be copied."
(interactive "BPrepend to buffer: \nr")
(let ((oldbuf (current-buffer)))
- (save-excursion
- (set-buffer (get-buffer-create buffer))
+ (with-current-buffer (get-buffer-create buffer)
(barf-if-buffer-read-only)
(save-excursion
(insert-buffer-substring oldbuf start end)))))
(insert-buffer-substring oldbuf start end)))))
\f
(put 'mark-inactive 'error-conditions '(mark-inactive error))
-(put 'mark-inactive 'error-message "The mark is not active now")
+(put 'mark-inactive 'error-message (purecopy "The mark is not active now"))
(defvar activate-mark-hook nil
"Hook run when the mark becomes active.
(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 ()
+(declare-function x-selection-owner-p "xselect.c" (&optional selection))
+
+(defsubst deactivate-mark (&optional force)
"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'."
- (when transient-mark-mode
- (if (or (eq transient-mark-mode 'lambda)
- (and (eq (car-safe transient-mark-mode) 'only)
- (null (cdr transient-mark-mode))))
+Unless FORCE is non-nil, this function does nothing if Transient
+Mark mode is disabled.
+This function also runs `deactivate-mark-hook'."
+ (when (or transient-mark-mode force)
+ (when (and (if (eq select-active-regions 'only)
+ (eq (car-safe transient-mark-mode) 'only)
+ select-active-regions)
+ (region-active-p)
+ (display-selections-p))
+ ;; The var `saved-region-selection', if non-nil, is the text in
+ ;; the region prior to the last command modifying the buffer.
+ ;; Set the selection to that, or to the current region.
+ (cond (saved-region-selection
+ (x-set-selection 'PRIMARY saved-region-selection)
+ (setq saved-region-selection nil))
+ ((/= (region-beginning) (region-end))
+ (x-set-selection 'PRIMARY
+ (buffer-substring-no-properties
+ (region-beginning)
+ (region-end))))))
+ (if (and (null force)
+ (or (eq transient-mark-mode 'lambda)
+ (and (eq (car-safe transient-mark-mode) 'only)
+ (null (cdr transient-mark-mode)))))
+ ;; When deactivating a temporary region, don't change
+ ;; `mark-active' or run `deactivate-mark-hook'.
(setq transient-mark-mode nil)
(if (eq (car-safe transient-mark-mode) 'only)
(setq transient-mark-mode (cdr transient-mark-mode)))
(unless transient-mark-mode
(setq transient-mark-mode 'lambda))))
-(defcustom select-active-regions nil
- "If non-nil, an active region automatically becomes the window selection."
- :type 'boolean
- :group 'killing
- :version "23.1")
-
(defun set-mark (pos)
"Set this buffer's mark to POS. Don't use this function!
That is to say, don't use this function unless you want
(progn
(setq mark-active t)
(run-hooks 'activate-mark-hook)
- (and select-active-regions
- (x-set-selection
- nil (buffer-substring (region-beginning) (region-end))))
(set-marker (mark-marker) pos (current-buffer)))
;; Normally we never clear mark-active except in Transient Mark mode.
- ;; But when we actually clear out the mark value too,
- ;; we must clear mark-active in any mode.
- (setq mark-active nil)
- (run-hooks 'deactivate-mark-hook)
+ ;; But when we actually clear out the mark value too, we must
+ ;; clear mark-active in any mode.
+ (deactivate-mark t)
(set-marker (mark-marker) nil)))
(defcustom use-empty-active-region nil
- "If non-nil, an active region takes control even if empty.
-This applies to certain commands which, in Transient Mark mode,
-apply to the active region if there is one. If the setting is t,
-these commands apply to an empty active region if there is one.
-If the setting is nil, these commands treat an empty active
-region as if it were not active."
+ "Whether \"region-aware\" commands should act on empty regions.
+If nil, region-aware commands treat empty regions as inactive.
+If non-nil, region-aware commands treat the region as active as
+long as the mark is active, even if the region is empty.
+
+Region-aware commands are those that act on the region if it is
+active and Transient Mark mode is enabled, and on the text near
+point otherwise."
:type 'boolean
:version "23.1"
:group 'editing-basics)
(defun use-region-p ()
- "Return t if certain commands should apply to the region.
-Certain commands normally apply to text near point,
-but in Transient Mark mode when the mark is active they apply
-to the region instead. Such commands should use this subroutine to
-test whether to do that.
+ "Return t if the region is active and it is appropriate to act on it.
+This is used by commands that act specially on the region under
+Transient Mark mode.
+
+The return value is t if Transient Mark mode is enabled and the
+mark is active; furthermore, if `use-empty-active-region' is nil,
+the region must not be empty. Otherwise, the return value is nil.
-This function also obeys `use-empty-active-region'."
+For some commands, it may be appropriate to ignore the value of
+`use-empty-active-region'; in that case, use `region-active-p'."
(and (region-active-p)
(or use-empty-active-region (> (region-end) (region-beginning)))))
(defun region-active-p ()
"Return t if Transient Mark mode is enabled and the mark is active.
-This is NOT the best function to use to test whether a command should
-operate on the region instead of the usual behavior -- for that,
-use `use-region-p'."
+
+Some commands act specially on the region when Transient Mark
+mode is enabled. Usually, such commands should use
+`use-region-p' instead of this function, because `use-region-p'
+also checks the value of `use-empty-active-region'."
(and transient-mark-mode mark-active))
(defvar mark-ring nil
(put 'mark-ring 'permanent-local t)
(defcustom mark-ring-max 16
- "*Maximum size of mark ring. Start discarding off end if gets this big."
+ "Maximum size of mark ring. Start discarding off end if gets this big."
:type 'integer
:group 'editing-basics)
"The list of saved global marks, most recent first.")
(defcustom global-mark-ring-max 16
- "*Maximum size of global mark ring. \
+ "Maximum size of global mark ring. \
Start discarding off end if gets this big."
:type 'integer
:group 'editing-basics)
(defun pop-to-mark-command ()
- "Jump to mark, and pop a new position for mark off the ring
-\(does not affect global mark ring\)."
+ "Jump to mark, and pop a new position for mark off the ring.
+\(Does not affect global mark ring\)."
(interactive)
(if (null (mark t))
(error "No mark set in this buffer")
(defun push-mark-command (arg &optional nomsg)
"Set mark at where point is.
-If no prefix arg and mark is already set there, just activate it.
+If no prefix ARG and mark is already set there, just activate it.
Display `Mark set' unless the optional second arg NOMSG is non-nil."
(interactive "P")
(let ((mark (marker-position (mark-marker))))
(message "Mark activated")))))
(defcustom set-mark-command-repeat-pop nil
- "*Non-nil means repeating \\[set-mark-command] after popping mark pops it again.
+ "Non-nil means repeating \\[set-mark-command] after popping mark pops it again.
That means that C-u \\[set-mark-command] \\[set-mark-command]
will pop the mark twice, and
C-u \\[set-mark-command] \\[set-mark-command] \\[set-mark-command]
:type 'boolean
:group 'editing-basics)
+(defcustom set-mark-default-inactive nil
+ "If non-nil, setting the mark does not activate it.
+This causes \\[set-mark-command] and \\[exchange-point-and-mark] to
+behave the same whether or not `transient-mark-mode' is enabled."
+ :type 'boolean
+ :group 'editing-basics
+ :version "23.1")
+
(defun set-mark-command (arg)
"Set the mark where point is, or jump to the mark.
Setting the mark also alters the region, which is the text
(activate-mark)
(message "Mark activated")))
(t
- (push-mark-command nil))))
+ (push-mark-command nil)
+ (if set-mark-default-inactive (deactivate-mark)))))
(defun push-mark (&optional location nomsg activate)
"Set mark at LOCATION (point, by default) and push old mark on mark ring.
(setq mark-ring (cdr mark-ring)))
(deactivate-mark))
-(defalias 'exchange-dot-and-mark 'exchange-point-and-mark)
+(define-obsolete-function-alias
+ 'exchange-dot-and-mark 'exchange-point-and-mark "23.3")
(defun exchange-point-and-mark (&optional arg)
"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.
-If Transient Mark mode is on, a prefix arg deactivates the mark
+If Transient Mark mode is on, a prefix ARG deactivates the mark
if it is active, and otherwise avoids reactivating it. If
-Transient Mark mode is off, a prefix arg enables Transient Mark
+Transient Mark mode is off, a prefix ARG enables Transient Mark
mode temporarily."
(interactive "P")
(let ((omark (mark t))
(deactivate-mark)
(set-mark (point))
(goto-char omark)
+ (if set-mark-default-inactive (deactivate-mark))
(cond (temp-highlight
(setq transient-mark-mode (cons 'only transient-mark-mode)))
((or (and arg (region-active-p)) ; (xor arg (not (region-active-p)))
(t (activate-mark)))
nil))
-(defun handle-shift-selection (&optional deactivate)
- "Check for shift translation, and operate on the mark accordingly.
-This is called whenever a command with a `^' character in its
-`interactive' spec is invoked while `shift-select-mode' is
-non-nil.
-
-If the command was invoked through shift-translation, set the
-mark and activate the region temporarily, unless it was already
-set in this way. If the command was invoked without
-shift-translation and a region is temporarily active, deactivate
-the mark.
-
-With optional arg DEACTIVATE, only perform region deactivation."
- (cond ((and this-command-keys-shift-translated
- (null deactivate))
- (unless (and mark-active
+(defcustom shift-select-mode t
+ "When non-nil, shifted motion keys activate the mark momentarily.
+
+While the mark is activated in this way, any shift-translated point
+motion key extends the region, and if Transient Mark mode was off, it
+is temporarily turned on. Furthermore, the mark will be deactivated
+by any subsequent point motion key that was not shift-translated, or
+by any action that normally deactivates the mark in Transient Mark mode.
+
+See `this-command-keys-shift-translated' for the meaning of
+shift-translation."
+ :type 'boolean
+ :group 'editing-basics)
+
+(defun handle-shift-selection ()
+ "Activate/deactivate mark depending on invocation thru shift translation.
+This function is called by `call-interactively' when a command
+with a `^' character in its `interactive' spec is invoked, before
+running the command itself.
+
+If `shift-select-mode' is enabled and the command was invoked
+through shift translation, set the mark and activate the region
+temporarily, unless it was already set in this way. See
+`this-command-keys-shift-translated' for the meaning of shift
+translation.
+
+Otherwise, if the region has been activated temporarily,
+deactivate it, and restore the variable `transient-mark-mode' to
+its earlier value."
+ (cond ((and shift-select-mode this-command-keys-shift-translated)
+ (unless (and mark-active
(eq (car-safe transient-mark-mode) 'only))
(setq transient-mark-mode
- (cons 'only
- (unless (eq transient-mark-mode 'lambda)
- transient-mark-mode)))
- (push-mark nil nil t)))
- ((eq (car-safe transient-mark-mode) 'only)
- (setq transient-mark-mode (cdr transient-mark-mode))
- (deactivate-mark))))
+ (cons 'only
+ (unless (eq transient-mark-mode 'lambda)
+ transient-mark-mode)))
+ (push-mark nil nil t)))
+ ((eq (car-safe transient-mark-mode) 'only)
+ (setq transient-mark-mode (cdr transient-mark-mode))
+ (deactivate-mark))))
(define-minor-mode transient-mark-mode
"Toggle Transient Mark mode.
-With arg, turn Transient Mark mode on if arg is positive, off otherwise.
+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.
commands which are sensitive to the Transient Mark mode."
:global t
:init-value (not noninteractive)
+ :initialize 'custom-initialize-delay
:group 'editing-basics)
;; The variable transient-mark-mode is ugly: it can take on special
The variable `highlight-nonselected-windows' controls whether to highlight
all windows or just the selected window.
-If the value is `lambda', that enables Transient Mark mode
-temporarily. After any subsequent action that would normally
-deactivate the mark (such as buffer modification), Transient Mark mode
-is turned off.
+If the value is `lambda', that enables Transient Mark mode temporarily.
+After any subsequent action that would normally deactivate the mark
+\(such as buffer modification), Transient Mark mode is turned off.
If the value is (only . OLDVAL), that enables Transient Mark mode
temporarily. After any subsequent point motion command that is not
If `widen-automatically' is nil, these commands will do something else
as a fallback, and won't change the buffer bounds.")
+(defvar non-essential nil
+ "Whether the currently executing code is performing an essential task.
+This variable should be non-nil only when running code which should not
+disturb the user. E.g. it can be used to prevent Tramp from prompting the
+user for a password when we are simply scanning a set of files in the
+background or displaying possible completions before the user even asked
+for it.")
+
(defun pop-global-mark ()
"Pop off global mark ring and jump to the top location."
(interactive)
(switch-to-buffer buffer)))
\f
(defcustom next-line-add-newlines nil
- "*If non-nil, `next-line' inserts newline to avoid `end of buffer' error."
+ "If non-nil, `next-line' inserts newline to avoid `end of buffer' error."
:type 'boolean
:version "21.1"
:group 'editing-basics)
(end-of-line)
(insert (if use-hard-newlines hard-newline "\n")))
(line-move arg nil nil try-vscroll))
- (if (interactive-p)
- (condition-case nil
+ (if (called-interactively-p 'interactive)
+ (condition-case err
(line-move arg nil nil try-vscroll)
- ((beginning-of-buffer end-of-buffer) (ding)))
+ ((beginning-of-buffer end-of-buffer)
+ (signal (car err) (cdr err))))
(line-move arg nil nil try-vscroll)))
nil)
to use and more reliable (no dependence on goal column, etc.)."
(interactive "^p\np")
(or arg (setq arg 1))
- (if (interactive-p)
- (condition-case nil
+ (if (called-interactively-p 'interactive)
+ (condition-case err
(line-move (- arg) nil nil try-vscroll)
- ((beginning-of-buffer end-of-buffer) (ding)))
+ ((beginning-of-buffer end-of-buffer)
+ (signal (car err) (cdr err))))
(line-move (- arg) nil nil try-vscroll))
nil)
(defcustom track-eol nil
- "*Non-nil means vertical motion starting at end of line keeps to ends of lines.
+ "Non-nil means vertical motion starting at end of line keeps to ends of lines.
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.
This has no effect when `line-move-visual' is non-nil."
:group 'editing-basics)
(defcustom goal-column nil
- "*Semipermanent goal column for vertical motion, as set by \\[set-goal-column], or nil."
+ "Semipermanent goal column for vertical motion, as set by \\[set-goal-column], or nil."
:type '(choice integer
(const :tag "None" nil))
:group 'editing-basics)
(defvar temporary-goal-column 0
"Current goal column for vertical motion.
It is the column where point was at the start of the current run
-of vertical motion commands. It is a floating point number when
-moving by visual lines via `line-move-visual'; this is the
-x-position, in pixels, divided by the default column width. When
-the `track-eol' feature is doing its job, the value is
+of vertical motion commands.
+
+When moving by visual lines via `line-move-visual', it is a cons
+cell (COL . HSCROLL), where COL is the x-position, in pixels,
+divided by the default column width, and HSCROLL is the number of
+columns by which window is scrolled from left margin.
+
+When the `track-eol' feature is doing its job, the value is
`most-positive-fixnum'.")
(defcustom line-move-ignore-invisible t
- "*Non-nil means \\[next-line] and \\[previous-line] ignore invisible lines.
+ "Non-nil means \\[next-line] and \\[previous-line] ignore invisible lines.
Outline mode sets this."
:type 'boolean
:group 'editing-basics)
;; Arg says how many lines to move. The value is t if we can move the
;; specified number of lines.
(defun line-move-visual (arg &optional noerror)
- (unless (and (floatp temporary-goal-column)
- (or (memq last-command '(next-line previous-line))
- ;; In case we're called from some other command.
- (eq last-command this-command)))
- (let ((x (car (nth 2 (posn-at-point)))))
- (when x
- (setq temporary-goal-column (/ (float x) (frame-char-width))))))
- (or (= (vertical-motion
- (cons (or goal-column (truncate temporary-goal-column)) arg))
- arg)
- (unless noerror
- (signal (if (< arg 0)
- 'beginning-of-buffer
- 'end-of-buffer)
- nil))))
+ (let ((opoint (point))
+ (hscroll (window-hscroll))
+ target-hscroll)
+ ;; Check if the previous command was a line-motion command, or if
+ ;; we were called from some other command.
+ (if (and (consp temporary-goal-column)
+ (memq last-command `(next-line previous-line ,this-command)))
+ ;; If so, there's no need to reset `temporary-goal-column',
+ ;; but we may need to hscroll.
+ (if (or (/= (cdr temporary-goal-column) hscroll)
+ (> (cdr temporary-goal-column) 0))
+ (setq target-hscroll (cdr temporary-goal-column)))
+ ;; Otherwise, we should reset `temporary-goal-column'.
+ (let ((posn (posn-at-point)))
+ (cond
+ ;; Handle the `overflow-newline-into-fringe' case:
+ ((eq (nth 1 posn) 'right-fringe)
+ (setq temporary-goal-column (cons (- (window-width) 1) hscroll)))
+ ((car (posn-x-y posn))
+ (setq temporary-goal-column
+ (cons (/ (float (car (posn-x-y posn)))
+ (frame-char-width)) hscroll))))))
+ (if target-hscroll
+ (set-window-hscroll (selected-window) target-hscroll))
+ (or (and (= (vertical-motion
+ (cons (or goal-column
+ (if (consp temporary-goal-column)
+ (truncate (car temporary-goal-column))
+ temporary-goal-column))
+ arg))
+ arg)
+ (or (>= arg 0)
+ (/= (point) opoint)
+ ;; If the goal column lies on a display string,
+ ;; `vertical-motion' advances the cursor to the end
+ ;; of the string. For arg < 0, this can cause the
+ ;; cursor to get stuck. (Bug#3020).
+ (= (vertical-motion arg) arg)))
+ (unless noerror
+ (signal (if (< arg 0) 'beginning-of-buffer 'end-of-buffer)
+ nil)))))
;; This is the guts of next-line and previous-line.
;; Arg says how many lines to move.
(let ((inhibit-point-motion-hooks t)
(opoint (point))
(orig-arg arg))
- (if (floatp temporary-goal-column)
- (setq temporary-goal-column (truncate temporary-goal-column)))
+ (if (consp temporary-goal-column)
+ (setq temporary-goal-column (+ (car temporary-goal-column)
+ (cdr temporary-goal-column))))
(unwind-protect
(progn
(if (not (memq last-command '(next-line previous-line)))
(point))))
;; Move to the desired column.
- (line-move-to-column column)
+ (line-move-to-column (truncate column))
;; Corner case: suppose we start out in a field boundary in
;; the middle of a continued line. When we get to
(defun move-end-of-line (arg)
"Move point to end of current line as displayed.
-\(If there's an image in the line, this disregards newlines
-which are part of the text that the image rests on.)
-
With argument ARG not nil or 1, move forward ARG - 1 lines first.
If point reaches the beginning or end of buffer, it stops there.
-To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
+
+To ignore the effects of the `intangible' text or overlay
+property, bind `inhibit-point-motion-hooks' to t.
+If there is an image in the current line, this function
+disregards newlines that are part of the text on which the image
+rests."
(interactive "^p")
(or arg (setq arg 1))
(let (done)
(let ((goal-column 0)
(line-move-visual nil))
(and (line-move arg t)
+ ;; With bidi reordering, we may not be at bol,
+ ;; so make sure we are.
+ (skip-chars-backward "^\n")
(not (bobp))
(progn
(while (and (not (bobp)) (invisible-p (1- (point))))
(/= arg 1) t 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.
+;; 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
+With a non-nil argument ARG, clears out the goal column
so that \\[next-line] and \\[previous-line] resume vertical motion.
The goal column is stored in the variable `goal-column'."
(interactive "P")
(if (/= n 1)
(let ((line-move-visual t))
(line-move (1- n) t)))
+ ;; Unlike `move-beginning-of-line', `move-end-of-line' doesn't
+ ;; constrain to field boundaries, so we don't either.
(vertical-motion (cons (window-width) 0)))
(defun beginning-of-visual-line (&optional n)
To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
(interactive "^p")
(or n (setq n 1))
- (if (/= n 1)
- (let ((line-move-visual t))
- (line-move (1- n) t)))
- (vertical-motion 0))
+ (let ((opoint (point)))
+ (if (/= n 1)
+ (let ((line-move-visual t))
+ (line-move (1- n) t)))
+ (vertical-motion 0)
+ ;; Constrain to field boundaries, like `move-beginning-of-line'.
+ (goto-char (constrain-to-field (point) opoint (/= n 1)))))
(defun kill-visual-line (&optional arg)
"Kill the rest of the visual line.
-If there are only whitespace characters there, kill through the
-newline as well.
-
-With prefix argument, kill that many lines from point.
-Negative arguments kill lines backward.
-With zero argument, kill the text before point on the current line.
-
-When calling from a program, nil means \"no arg\",
-a number counts as a prefix arg.
-
-If `kill-whole-line' is non-nil, then this command kills the whole line
-including its terminating newline, when used at the beginning of a line
-with no argument. As a consequence, you can always kill a whole line
-by typing \\[beginning-of-line] \\[kill-line].
+With prefix argument ARG, kill that many visual lines from point.
+If ARG is negative, kill visual lines backward.
+If ARG is zero, kill the text before point on the current visual
+line.
If you want to append the killed line to the last killed text,
use \\[append-next-kill] before \\[kill-line].
\(If the variable `kill-read-only-ok' is non-nil, then this won't
even beep.)"
(interactive "P")
+ ;; Like in `kill-line', it's better to move point to the other end
+ ;; of the kill before killing.
(let ((opoint (point))
- (line-move-visual t)
- end)
- ;; It is better to move point to the other end of the kill before
- ;; killing. That way, in a read-only buffer, point moves across
- ;; the text that is copied to the kill ring. The choice has no
- ;; effect on undo now that undo records the value of point from
- ;; before the command was run.
+ (kill-whole-line (and kill-whole-line (bolp))))
(if arg
(vertical-motion (prefix-numeric-value arg))
- (if (eobp)
- (signal 'end-of-buffer nil))
- (setq end (save-excursion
- (end-of-visual-line) (point)))
- (if (or (save-excursion
- ;; If trailing whitespace is visible,
- ;; don't treat it as nothing.
- (unless show-trailing-whitespace
- (skip-chars-forward " \t" end))
- (= (point) end))
- (and kill-whole-line (bolp)))
- (line-move 1)
- (goto-char end)))
- (kill-region opoint (point))))
+ (end-of-visual-line 1)
+ (if (= (point) opoint)
+ (vertical-motion 1)
+ ;; Skip any trailing whitespace at the end of the visual line.
+ ;; We used to do this only if `show-trailing-whitespace' is
+ ;; nil, but that's wrong; the correct thing would be to check
+ ;; whether the trailing whitespace is highlighted. But, it's
+ ;; OK to just do this unconditionally.
+ (skip-chars-forward " \t")))
+ (kill-region opoint (if (and kill-whole-line (looking-at "\n"))
+ (1+ (point))
+ (point)))))
(defun next-logical-line (&optional arg try-vscroll)
"Move cursor vertically down ARG lines.
-This is identical to `previous-line', except that it always moves
+This is identical to `next-line', except that it always moves
by logical lines instead of visual lines, ignoring the value of
the variable `line-move-visual'."
(interactive "^p\np")
(define-key map [remap kill-line] 'kill-visual-line)
(define-key map [remap move-beginning-of-line] 'beginning-of-visual-line)
(define-key map [remap move-end-of-line] 'end-of-visual-line)
- (define-key map "\M-[" 'previous-logical-line)
- (define-key map "\M-]" 'next-logical-line)
+ ;; These keybindings interfere with xterm function keys. Are
+ ;; there any other suitable bindings?
+ ;; (define-key map "\M-[" 'previous-logical-line)
+ ;; (define-key map "\M-]" 'next-logical-line)
map))
(defcustom visual-line-fringe-indicators '(nil nil)
This also turns on `word-wrap' in the buffer."
:keymap visual-line-mode-map
:group 'visual-line
- :lighter " wrap"
+ :lighter " Wrap"
(if visual-line-mode
(progn
(set (make-local-variable 'visual-line--saved-state) nil)
(define-globalized-minor-mode global-visual-line-mode
visual-line-mode turn-on-visual-line-mode
:lighter " vl")
-\f
-(defun scroll-other-window-down (lines)
- "Scroll the \"other window\" down.
-For more details, see the documentation for `scroll-other-window'."
- (interactive "P")
- (scroll-other-window
- ;; Just invert the argument's meaning.
- ;; We can do that without knowing which window it will be.
- (if (eq lines '-) nil
- (if (null lines) '-
- (- (prefix-numeric-value lines))))))
-
-(defun beginning-of-buffer-other-window (arg)
- "Move point to the beginning of the buffer in the other window.
-Leave mark at previous position.
-With arg N, put point N/10 of the way from the true beginning."
- (interactive "P")
- (let ((orig-window (selected-window))
- (window (other-window-for-scrolling)))
- ;; We use unwind-protect rather than save-window-excursion
- ;; because the latter would preserve the things we want to change.
- (unwind-protect
- (progn
- (select-window window)
- ;; Set point and mark in that window's buffer.
- (with-no-warnings
- (beginning-of-buffer arg))
- ;; Set point accordingly.
- (recenter '(t)))
- (select-window orig-window))))
-
-(defun end-of-buffer-other-window (arg)
- "Move point to the end of the buffer in the other window.
-Leave mark at previous position.
-With arg N, put point N/10 of the way from the true end."
- (interactive "P")
- ;; See beginning-of-buffer-other-window for comments.
- (let ((orig-window (selected-window))
- (window (other-window-for-scrolling)))
- (unwind-protect
- (progn
- (select-window window)
- (with-no-warnings
- (end-of-buffer arg))
- (recenter '(t)))
- (select-window orig-window))))
+
\f
(defun transpose-chars (arg)
"Interchange characters around point, moving forward one character.
(forward-line arg))))
arg))
+;; FIXME seems to leave point BEFORE the current object when ARG = 0,
+;; which seems inconsistent with the ARG /= 0 case.
+;; FIXME document SPECIAL.
(defun transpose-subr (mover arg &optional special)
+ "Subroutine to do the work of transposing objects.
+Works for lines, sentences, paragraphs, etc. MOVER is a function that
+moves forward by units of the given object (e.g. forward-sentence,
+forward-paragraph). If ARG is zero, exchanges the current object
+with the one containing mark. If ARG is an integer, moves the
+current object past ARG following (if ARG is positive) or
+preceding (if ARG is negative) objects, leaving point after the
+current object."
(let ((aux (if special mover
(lambda (x)
(cons (progn (funcall mover x) (point))
((= arg 0)
(save-excursion
(setq pos1 (funcall aux 1))
- (goto-char (mark))
+ (goto-char (or (mark) (error "No mark set in this buffer")))
(setq pos2 (funcall aux 1))
(transpose-subr-1 pos1 pos2))
(exchange-point-and-mark))
\f
(defun backward-word (&optional arg)
"Move backward until encountering the beginning of a word.
-With argument, do this that many times."
+With argument ARG, do this that many times."
(interactive "^p")
(forward-word (- (or arg 1))))
(defun kill-word (arg)
"Kill characters forward until encountering the end of a word.
-With argument, do this that many times."
+With argument ARG, do this that many times."
(interactive "p")
(kill-region (point) (progn (forward-word arg) (point))))
(defun backward-kill-word (arg)
"Kill characters backward until encountering the beginning of a word.
-With argument, do this that many times."
+With argument ARG, do this that many times."
(interactive "p")
(kill-word (- arg)))
(buffer-substring-no-properties start end)))))
\f
(defcustom fill-prefix nil
- "*String for filling to insert at front of new line, or nil for none."
+ "String for filling to insert at front of new line, or nil for none."
:type '(choice (const :tag "None" nil)
string)
:group 'fill)
(put 'fill-prefix 'safe-local-variable 'string-or-null-p)
(defcustom auto-fill-inhibit-regexp nil
- "*Regexp to match lines which should not be auto-filled."
+ "Regexp to match lines which should not be auto-filled."
:type '(choice (const :tag "None" nil)
regexp)
:group 'fill)
Some major modes set this.")
(put 'auto-fill-function :minor-mode-function 'auto-fill-mode)
+;; `functions' and `hooks' are usually unsafe to set, but setting
+;; auto-fill-function to nil in a file-local setting is safe and
+;; can be useful to prevent auto-filling.
+(put 'auto-fill-function 'safe-local-variable 'null)
;; FIXME: turn into a proper minor mode.
;; Add a global minor mode version of it.
-(defun auto-fill-mode (&optional arg)
+(define-minor-mode auto-fill-mode
"Toggle Auto Fill mode.
-With arg, turn Auto Fill mode on if and only if arg is positive.
+With ARG, turn Auto Fill mode on if and only if ARG is positive.
In Auto Fill mode, inserting a space at a column beyond `current-fill-column'
automatically breaks the line at a previous space.
The value of `normal-auto-fill-function' specifies the function to use
for `auto-fill-function' when turning Auto Fill mode on."
- (interactive "P")
- (prog1 (setq auto-fill-function
- (if (if (null arg)
- (not auto-fill-function)
- (> (prefix-numeric-value arg) 0))
- normal-auto-fill-function
- nil))
- (force-mode-line-update)))
+ :variable (eq auto-fill-function normal-auto-fill-function))
;; This holds a document string used to document auto-fill-mode.
(defun auto-fill-function ()
(defun toggle-truncate-lines (&optional arg)
"Toggle whether to fold or truncate long lines for the current buffer.
With prefix argument ARG, truncate long lines if ARG is positive,
-otherwise don't truncate them. Note that in side-by-side
-windows, this command has no effect if `truncate-partial-width-windows'
+otherwise don't truncate them. Note that in side-by-side windows,
+this command has no effect if `truncate-partial-width-windows'
is non-nil."
(interactive "P")
(setq truncate-lines
(message "Truncate long lines %s"
(if truncate-lines "enabled" "disabled")))
-(defvar overwrite-mode-textual " Ovwrt"
+(defun toggle-word-wrap (&optional arg)
+ "Toggle whether to use word-wrapping for continuation lines.
+With prefix argument ARG, wrap continuation lines at word boundaries
+if ARG is positive, otherwise wrap them at the right screen edge.
+This command toggles the value of `word-wrap'. It has no effect
+if long lines are truncated."
+ (interactive "P")
+ (setq word-wrap
+ (if (null arg)
+ (not word-wrap)
+ (> (prefix-numeric-value arg) 0)))
+ (force-mode-line-update)
+ (message "Word wrapping %s"
+ (if word-wrap "enabled" "disabled")))
+
+(defvar overwrite-mode-textual (purecopy " Ovwrt")
"The string displayed in the mode line when in overwrite mode.")
-(defvar overwrite-mode-binary " Bin Ovwrt"
+(defvar overwrite-mode-binary (purecopy " Bin Ovwrt")
"The string displayed in the mode line when in binary overwrite mode.")
-(defun overwrite-mode (arg)
+(define-minor-mode overwrite-mode
"Toggle overwrite mode.
With prefix argument ARG, turn overwrite mode on if ARG is positive,
otherwise turn it off. In overwrite mode, printing characters typed
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 (if (null arg) (not overwrite-mode)
- (> (prefix-numeric-value arg) 0))
- 'overwrite-mode-textual))
- (force-mode-line-update))
+ :variable (eq overwrite-mode 'overwrite-mode-textual))
-(defun binary-overwrite-mode (arg)
+(define-minor-mode binary-overwrite-mode
"Toggle binary overwrite mode.
With prefix argument ARG, turn binary overwrite mode on if ARG is
positive, otherwise turn it off. In binary overwrite mode, printing
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))
+ :variable (eq overwrite-mode 'overwrite-mode-binary))
(define-minor-mode line-number-mode
"Toggle Line Number mode.
-With arg, turn Line Number mode on if arg is positive, otherwise
+With ARG, turn Line Number mode on if ARG is positive, otherwise
turn it off. When Line Number mode is enabled, the line number
appears in the mode line.
(define-minor-mode column-number-mode
"Toggle Column Number mode.
-With arg, turn Column Number mode on if arg is positive,
+With ARG, turn Column Number mode on if ARG is positive,
otherwise turn it off. When Column Number mode is enabled, the
column number appears in the mode line."
:global t :group 'mode-line)
(define-minor-mode size-indication-mode
"Toggle Size Indication mode.
-With arg, turn Size Indication mode on if arg is positive,
+With ARG, turn Size Indication mode on if ARG is positive,
otherwise turn it off. When Size Indication mode is enabled, the
size of the accessible part of the buffer appears in the mode line."
:global t :group 'mode-line)
+
+(define-minor-mode auto-save-mode
+ "Toggle auto-saving of contents of current buffer.
+With prefix argument ARG, turn auto-saving on if positive, else off."
+ :variable ((and buffer-auto-save-file-name
+ ;; If auto-save is off because buffer has shrunk,
+ ;; then toggling should turn it on.
+ (>= buffer-saved-size 0))
+ . (lambda (val)
+ (setq buffer-auto-save-file-name
+ (cond
+ ((null val) nil)
+ ((and buffer-file-name auto-save-visited-file-name
+ (not buffer-read-only))
+ buffer-file-name)
+ (t (make-auto-save-file-name))))))
+ ;; If -1 was stored here, to temporarily turn off saving,
+ ;; turn it back on.
+ (and (< buffer-saved-size 0)
+ (setq buffer-saved-size 0)))
\f
(defgroup paren-blinking nil
"Blinking matching of parens and expressions."
:group 'paren-matching)
(defcustom blink-matching-paren t
- "*Non-nil means show matching open-paren when close-paren is inserted."
+ "Non-nil means show matching open-paren when close-paren is inserted."
:type 'boolean
:group 'paren-blinking)
(defcustom blink-matching-paren-on-screen t
- "*Non-nil means show matching open-paren when it is on screen.
+ "Non-nil means show matching open-paren when it is on screen.
If nil, don't show it (but the open-paren can still be shown
when it is off screen).
:type 'boolean
:group 'paren-blinking)
-(defcustom blink-matching-paren-distance (* 25 1024)
- "*If non-nil, maximum distance to search backwards for matching open-paren.
+(defcustom blink-matching-paren-distance (* 100 1024)
+ "If non-nil, maximum distance to search backwards for matching open-paren.
If nil, search stops at the beginning of the accessible portion of the buffer."
+ :version "23.2" ; 25->100k
:type '(choice (const nil) integer)
:group 'paren-blinking)
(defcustom blink-matching-delay 1
- "*Time in seconds to delay after showing a matching paren."
+ "Time in seconds to delay after showing a matching paren."
:type 'number
:group 'paren-blinking)
(defcustom blink-matching-paren-dont-ignore-comments nil
- "*If nil, `blink-matching-paren' ignores comments.
+ "If nil, `blink-matching-paren' ignores comments.
More precisely, when looking for the matching parenthesis,
it skips the contents of comments that end before point."
:type 'boolean
(and parse-sexp-ignore-comments
(not blink-matching-paren-dont-ignore-comments))))
(condition-case ()
- (scan-sexps oldpos -1)
+ (progn
+ (forward-sexp -1)
+ (point))
(error nil))))))
(matching-paren
(and blinkpos
;; a matching-char info, in which case the two CDRs
;; should match.
(eq matching-paren (cdr (syntax-after (1- oldpos))))))
- (message "Mismatched parentheses"))
+ (if (minibufferp)
+ (minibuffer-message " [Mismatched parentheses]")
+ (message "Mismatched parentheses")))
((not blinkpos)
(or blink-matching-paren-distance
;; Don't complain when `$' with no blinkpos, because it
;; could just be the first one typed in the buffer.
atdollar
- (message "Unmatched parenthesis")))
+ (if (minibufferp)
+ (minibuffer-message " [Unmatched parenthesis]")
+ (message "Unmatched parenthesis"))))
((pos-visible-in-window-p blinkpos)
;; Matching open within window, temporarily move to blinkpos but only
;; if `blink-matching-paren-on-screen' is non-nil.
(message "Matches %s"
(substring-no-properties open-paren-line-string)))))))))
-;; Turned off because it makes dbx bomb out.
(setq blink-paren-function 'blink-matching-open)
\f
;; This executes C-g typed while Emacs is waiting for a command.
During execution of Lisp code, this character causes a quit directly.
At top-level, as an editor command, this simply beeps."
(interactive)
- (deactivate-mark)
+ ;; Avoid adding the region to the window selection.
+ (setq saved-region-selection nil)
+ (let (select-active-regions)
+ (deactivate-mark))
(if (fboundp 'kmacro-keyboard-quit)
(kmacro-keyboard-quit))
(setq defining-kbd-macro nil)
or go back to just one window (by deleting all but the selected window)."
(interactive)
(cond ((eq last-command 'mode-exited) nil)
+ ((region-active-p)
+ (deactivate-mark))
((> (minibuffer-depth) 0)
(abort-recursive-edit))
(current-prefix-arg
nil)
- ((region-active-p)
- (deactivate-mark))
((> (recursion-depth) 0)
(exit-recursive-edit))
(buffer-quit-function
\f
(defcustom read-mail-command 'rmail
- "*Your preference for a mail reading package.
+ "Your preference for a mail reading package.
This is used by some keybindings which support reading mail.
See also `mail-user-agent' concerning sending mail."
- :type '(choice (function-item rmail)
- (function-item gnus)
- (function-item mh-rmail)
- (function :tag "Other"))
+ :type '(radio (function-item :tag "Rmail" :format "%t\n" rmail)
+ (function-item :tag "Gnus" :format "%t\n" gnus)
+ (function-item :tag "Emacs interface to MH"
+ :format "%t\n" mh-rmail)
+ (function :tag "Other"))
:version "21.1"
:group 'mail)
-(defcustom mail-user-agent 'sendmail-user-agent
- "*Your preference for a mail composition package.
+(defcustom mail-user-agent 'message-user-agent
+ "Your preference for a mail composition package.
Various Emacs Lisp packages (e.g. Reporter) require you to compose an
outgoing email message. This variable lets you specify which
mail-sending package you prefer.
Valid values include:
- `sendmail-user-agent' -- use the default Emacs Mail package.
+ `message-user-agent' -- use the Message package.
+ See Info node `(message)'.
+ `sendmail-user-agent' -- use the Mail package.
See Info node `(emacs)Sending Mail'.
`mh-e-user-agent' -- use the Emacs interface to the MH mail system.
See Info node `(mh-e)'.
- `message-user-agent' -- use the Gnus Message package.
- See Info node `(message)'.
`gnus-user-agent' -- like `message-user-agent', but with Gnus
paraphernalia, particularly the Gcc: header for
archiving.
succeeds.
See also `read-mail-command' concerning reading mail."
- :type '(radio (function-item :tag "Default Emacs mail"
+ :type '(radio (function-item :tag "Message package"
+ :format "%t\n"
+ message-user-agent)
+ (function-item :tag "Mail package"
:format "%t\n"
sendmail-user-agent)
(function-item :tag "Emacs interface to MH"
:format "%t\n"
mh-e-user-agent)
- (function-item :tag "Gnus Message package"
- :format "%t\n"
- message-user-agent)
- (function-item :tag "Gnus Message with full Gnus features"
+ (function-item :tag "Message with full Gnus features"
:format "%t\n"
gnus-user-agent)
(function :tag "Other"))
+ :version "23.2" ; sendmail->message
+ :group 'mail)
+
+(defcustom compose-mail-user-agent-warnings t
+ "If non-nil, `compose-mail' warns about changes in `mail-user-agent'.
+If the value of `mail-user-agent' is the default, and the user
+appears to have customizations applying to the old default,
+`compose-mail' issues a warning."
+ :type 'boolean
+ :version "23.2"
:group 'mail)
(define-mail-user-agent 'sendmail-user-agent
HEADER and VALUE are strings.
CONTINUE, if non-nil, says to continue editing a message already
-being composed.
+being composed. Interactively, CONTINUE is the prefix argument.
SWITCH-FUNCTION, if non-nil, is a function to use to
switch to and display the buffer used for mail composition.
Each action has the form (FUNCTION . ARGS)."
(interactive
(list nil nil nil current-prefix-arg))
+
+ ;; In Emacs 23.2, the default value of `mail-user-agent' changed
+ ;; from sendmail-user-agent to message-user-agent. Some users may
+ ;; encounter incompatibilities. This hack tries to detect problems
+ ;; and warn about them.
+ (and compose-mail-user-agent-warnings
+ (eq mail-user-agent 'message-user-agent)
+ (let (warn-vars)
+ (dolist (var '(mail-mode-hook mail-send-hook mail-setup-hook
+ mail-yank-hooks mail-archive-file-name
+ mail-default-reply-to mail-mailing-lists
+ mail-self-blind))
+ (and (boundp var)
+ (symbol-value var)
+ (push var warn-vars)))
+ (when warn-vars
+ (display-warning 'mail
+ (format "\
+The default mail mode is now Message mode.
+You have the following Mail mode variable%s customized:
+\n %s\n\nTo use Mail mode, set `mail-user-agent' to sendmail-user-agent.
+To disable this warning, set `compose-mail-user-agent-warnings' to nil."
+ (if (> (length warn-vars) 1) "s" "")
+ (mapconcat 'symbol-name
+ warn-vars " "))))))
+
(let ((function (get mail-user-agent 'composefunc)))
(funcall function to subject other-headers continue
switch-function yank-action send-actions)))
(define-key map "\e\e\e" 'delete-completion-window)
(define-key map [left] 'previous-completion)
(define-key map [right] 'next-completion)
+ (define-key map "q" 'quit-window)
map)
"Local map for completion list buffers.")
(defvar completion-no-auto-exit nil
"Non-nil means `choose-completion-string' should never exit the minibuffer.
-This also applies to other functions such as `choose-completion'
-and `mouse-choose-completion'.")
+This also applies to other functions such as `choose-completion'.")
+
+(defvar completion-base-position nil
+ "Position of the base of the text corresponding to the shown completions.
+This variable is used in the *Completions* buffers.
+Its value is a list of the form (START END) where START is the place
+where the completion should be inserted and END (if non-nil) is the end
+of the text to replace. If END is nil, point is used instead.")
(defvar completion-base-size nil
"Number of chars before point not involved in completion.
If nil, Emacs determines which part of the tail end of the
buffer's text is involved in completion by comparing the text
directly.")
+(make-obsolete-variable 'completion-base-size 'completion-base-position "23.2")
(defun delete-completion-window ()
"Delete the completion list window.
(point) 'mouse-face nil beg))
(setq n (1+ n))))))
-(defun choose-completion ()
- "Choose the completion that point is in or next to."
- (interactive)
- (let (beg end completion (buffer completion-reference-buffer)
- (base-size completion-base-size))
- (if (and (not (eobp)) (get-text-property (point) 'mouse-face))
- (setq end (point) beg (1+ (point))))
- (if (and (not (bobp)) (get-text-property (1- (point)) 'mouse-face))
- (setq end (1- (point)) beg (point)))
- (if (null beg)
- (error "No completion here"))
- (setq beg (previous-single-property-change beg 'mouse-face))
- (setq end (or (next-single-property-change end 'mouse-face) (point-max)))
- (setq completion (buffer-substring-no-properties beg end))
+(defun choose-completion (&optional event)
+ "Choose the completion at point."
+ (interactive (list last-nonmenu-event))
+ ;; In case this is run via the mouse, give temporary modes such as
+ ;; isearch a chance to turn off.
+ (run-hooks 'mouse-leave-buffer-hook)
+ (let (buffer base-size base-position choice)
+ (with-current-buffer (window-buffer (posn-window (event-start event)))
+ (setq buffer completion-reference-buffer)
+ (setq base-size completion-base-size)
+ (setq base-position completion-base-position)
+ (save-excursion
+ (goto-char (posn-point (event-start event)))
+ (let (beg end)
+ (if (and (not (eobp)) (get-text-property (point) 'mouse-face))
+ (setq end (point) beg (1+ (point))))
+ (if (and (not (bobp)) (get-text-property (1- (point)) 'mouse-face))
+ (setq end (1- (point)) beg (point)))
+ (if (null beg)
+ (error "No completion here"))
+ (setq beg (previous-single-property-change beg 'mouse-face))
+ (setq end (or (next-single-property-change end 'mouse-face)
+ (point-max)))
+ (setq choice (buffer-substring-no-properties beg end)))))
+
(let ((owindow (selected-window)))
+ (select-window (posn-window (event-start event)))
(if (and (one-window-p t 'selected-frame)
- (window-dedicated-p owindow))
+ (window-dedicated-p (selected-window)))
;; This is a special buffer's frame
(iconify-frame (selected-frame))
(or (window-dedicated-p (selected-window))
(bury-buffer)))
(select-window
(or (and (buffer-live-p buffer)
- (get-buffer-window buffer))
+ (get-buffer-window buffer 0))
owindow)))
- (choose-completion-string completion buffer base-size)))
+
+ (choose-completion-string
+ choice buffer
+ (or base-position
+ (when base-size
+ ;; Someone's using old completion code that doesn't know
+ ;; about base-position yet.
+ (list (+ base-size (with-current-buffer buffer (field-beginning)))))
+ ;; If all else fails, just guess.
+ (with-current-buffer buffer
+ (list (choose-completion-guess-base-position choice)))))))
;; Delete the longest partial match for STRING
;; that can be found before POINT.
+(defun choose-completion-guess-base-position (string)
+ (save-excursion
+ (let ((opoint (point))
+ len)
+ ;; Try moving back by the length of the string.
+ (goto-char (max (- (point) (length string))
+ (minibuffer-prompt-end)))
+ ;; See how far back we were actually able to move. That is the
+ ;; upper bound on how much we can match and delete.
+ (setq len (- opoint (point)))
+ (if completion-ignore-case
+ (setq string (downcase string)))
+ (while (and (> len 0)
+ (let ((tail (buffer-substring (point) opoint)))
+ (if completion-ignore-case
+ (setq tail (downcase tail)))
+ (not (string= tail (substring string 0 len)))))
+ (setq len (1- len))
+ (forward-char 1))
+ (point))))
+
(defun choose-completion-delete-max-match (string)
- (let ((opoint (point))
- len)
- ;; Try moving back by the length of the string.
- (goto-char (max (- (point) (length string))
- (minibuffer-prompt-end)))
- ;; See how far back we were actually able to move. That is the
- ;; upper bound on how much we can match and delete.
- (setq len (- opoint (point)))
- (if completion-ignore-case
- (setq string (downcase string)))
- (while (and (> len 0)
- (let ((tail (buffer-substring (point) opoint)))
- (if completion-ignore-case
- (setq tail (downcase tail)))
- (not (string= tail (substring string 0 len)))))
- (setq len (1- len))
- (forward-char 1))
- (delete-char len)))
+ (delete-region (choose-completion-guess-base-position string) (point)))
+(make-obsolete 'choose-completion-delete-max-match
+ 'choose-completion-guess-base-position "23.2")
(defvar choose-completion-string-functions nil
"Functions that may override the normal insertion of a completion choice.
If all functions in the list return nil, that means to use
the default method of inserting the completion in BUFFER.")
-(defun choose-completion-string (choice &optional buffer base-size)
+(defun choose-completion-string (choice &optional buffer base-position)
"Switch to BUFFER and insert the completion choice CHOICE.
-BASE-SIZE, if non-nil, says how many characters of BUFFER's text
-to keep. If it is nil, we call `choose-completion-delete-max-match'
-to decide what to delete."
+BASE-POSITION, says where to insert the completion."
;; If BUFFER is the minibuffer, exit the minibuffer
;; unless it is reading a file name and CHOICE is a directory,
;; or completion-no-auto-exit is non-nil.
+ ;; Some older code may call us passing `base-size' instead of
+ ;; `base-position'. It's difficult to make any use of `base-size',
+ ;; so we just ignore it.
+ (unless (consp base-position)
+ (message "Obsolete `base-size' passed to choose-completion-string")
+ (setq base-position nil))
+
(let* ((buffer (or buffer completion-reference-buffer))
(mini-p (minibufferp buffer)))
;; If BUFFER is a minibuffer, barf unless it's the currently
(set-buffer buffer)
(unless (run-hook-with-args-until-success
'choose-completion-string-functions
- choice buffer mini-p base-size)
+ ;; The fourth arg used to be `mini-p' but was useless
+ ;; (since minibufferp can be used on the `buffer' arg)
+ ;; and indeed unused. The last used to be `base-size', so we
+ ;; keep it to try and avoid breaking old code.
+ choice buffer base-position nil)
;; Insert the completion into the buffer where it was requested.
- ;; FIXME:
- ;; - There may not be a field at point, or there may be a field but
- ;; it's not a "completion field", in which case we have to
- ;; call choose-completion-delete-max-match even if base-size is set.
- ;; - we may need to delete further than (point) to (field-end),
- ;; depending on the completion-style, and for that we need to
- ;; extra data `completion-extra-size'.
- (if base-size
- (delete-region (+ base-size (field-beginning)) (point))
- (choose-completion-delete-max-match choice))
+ (delete-region (or (car base-position) (point))
+ (or (cadr base-position) (point)))
(insert choice)
(remove-text-properties (- (point) (length choice)) (point)
'(mouse-face nil))
minibuffer-completion-table
;; If this is reading a file name, and the file name chosen
;; is a directory, don't exit the minibuffer.
- (if (and minibuffer-completing-file-name
- (file-directory-p (field-string (point-max))))
- (let ((mini (active-minibuffer-window)))
- (select-window mini)
- (when minibuffer-auto-raise
- (raise-frame (window-frame mini))))
- (exit-minibuffer)))))))
+ (let* ((result (buffer-substring (field-beginning) (point)))
+ (bounds
+ (completion-boundaries result minibuffer-completion-table
+ minibuffer-completion-predicate
+ "")))
+ (if (eq (car bounds) (length result))
+ ;; The completion chosen leads to a new set of completions
+ ;; (e.g. it's a directory): don't exit the minibuffer yet.
+ (let ((mini (active-minibuffer-window)))
+ (select-window mini)
+ (when minibuffer-auto-raise
+ (raise-frame (window-frame mini))))
+ (exit-minibuffer))))))))
(define-derived-mode completion-list-mode nil "Completion List"
"Major mode for buffers showing lists of possible completions.
:version "22.1"
:group 'completion)
-;; This is for packages that need to bind it to a non-default regexp
-;; in order to make the first-differing character highlight work
-;; to their liking
-(defvar completion-root-regexp "^/"
- "Regexp to use in `completion-setup-function' to find the root directory.")
-
;; This function goes in completion-setup-hook, so that it is called
;; after the text of the completion list buffer is written.
(defun completion-setup-function ()
(let* ((mainbuf (current-buffer))
- (mbuf-contents (minibuffer-completion-contents))
- common-string-length)
- ;; 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 (expand-file-name mbuf-contents)))))
+ (base-dir
+ ;; When reading a file name in the minibuffer,
+ ;; try and find the right default-directory to set in the
+ ;; completion list buffer.
+ ;; FIXME: Why do we do that, actually? --Stef
+ (if minibuffer-completing-file-name
+ (file-name-as-directory
+ (expand-file-name
+ (substring (minibuffer-completion-contents)
+ 0 (or completion-base-size 0)))))))
(with-current-buffer standard-output
- (let ((base-size completion-base-size)) ;Read before killing localvars.
+ (let ((base-size completion-base-size) ;Read before killing localvars.
+ (base-position completion-base-position))
(completion-list-mode)
- (set (make-local-variable 'completion-base-size) base-size))
+ (set (make-local-variable 'completion-base-size) base-size)
+ (set (make-local-variable 'completion-base-position) base-position))
(set (make-local-variable 'completion-reference-buffer) mainbuf)
- (unless completion-base-size
- ;; This may be needed for old completion packages which don't use
- ;; completion-all-completions-with-base-size yet.
- (setq completion-base-size
- (cond
- (minibuffer-completing-file-name
- ;; For file name completion, use the number of chars before
- ;; the start of the file name component at point.
- (with-current-buffer mainbuf
- (save-excursion
- (skip-chars-backward completion-root-regexp)
- (- (point) (minibuffer-prompt-end)))))
- (minibuffer-completing-symbol nil)
- ;; Otherwise, in minibuffer, the base size is 0.
- ((minibufferp mainbuf) 0))))
+ (if base-dir (setq default-directory base-dir))
;; Maybe insert help string.
(when completion-show-help
(goto-char (point-min))
(defun switch-to-completions ()
"Select the completion list window."
(interactive)
- ;; Make sure we have a completions window.
- (or (get-buffer-window "*Completions*")
- (minibuffer-completion-help))
- (let ((window (get-buffer-window "*Completions*")))
+ (let ((window (or (get-buffer-window "*Completions*" 0)
+ ;; Make sure we have a completions window.
+ (progn (minibuffer-completion-help)
+ (get-buffer-window "*Completions*" 0)))))
(when window
(select-window window)
- (goto-char (point-min))
- (search-forward "\n\n" nil t)
- (forward-line 1))))
+ ;; In the new buffer, go to the first completion.
+ ;; FIXME: Perhaps this should be done in `minibuffer-completion-help'.
+ (when (bobp)
+ (next-completion 1)))))
\f
;;; Support keyboard commands to turn on various modifiers.
(kp-subtract ?-)
(kp-decimal ?.)
(kp-divide ?/)
- (kp-equal ?=)))
+ (kp-equal ?=)
+ ;; Do the same for various keys that are represented as symbols under
+ ;; GUIs but naturally correspond to characters.
+ (backspace 127)
+ (delete 127)
+ (tab ?\t)
+ (linefeed ?\n)
+ (clear ?\C-l)
+ (return ?\C-m)
+ (escape ?\e)
+ ))
\f
;;;;
;;;; forking a twin copy of a buffer.
from the minibuffer when invoked with a prefix arg. If NEWNAME is nil
or if not called with a prefix arg, NEWNAME defaults to the current
buffer's name. The name is modified by adding a `<N>' suffix to it
-or by incrementing the N in an existing suffix.
+or by incrementing the N in an existing suffix. Trying to clone a
+buffer whose major mode symbol has a non-nil `no-clone-indirect'
+property results in an error.
DISPLAY-FLAG non-nil means show the new buffer with `pop-to-buffer'.
This is always done when called interactively.
(if (if (eq normal-erase-is-backspace 'maybe)
(and (not noninteractive)
(or (memq system-type '(ms-dos windows-nt))
+ (memq window-system '(ns))
(and (memq window-system '(x))
(fboundp 'x-backspace-delete-keys-p)
(x-backspace-delete-keys-p))
normal-erase-is-backspace)
1 0)))))
-(defun normal-erase-is-backspace-mode (&optional arg)
+(define-minor-mode normal-erase-is-backspace-mode
"Toggle the Erase and Delete mode of the Backspace and Delete keys.
-With numeric arg, turn the mode on if and only if ARG is positive.
+With numeric ARG, turn the mode on if and only if ARG is positive.
On window systems, when this mode is on, Delete is mapped to C-d
and Backspace is mapped to DEL; when this mode is off, both
have both Backspace, Delete and F1 keys.
See also `normal-erase-is-backspace'."
- (interactive "P")
- (let ((enabled (or (and arg (> (prefix-numeric-value arg) 0))
- (and (not arg)
- (not (eq 1 (terminal-parameter
- nil 'normal-erase-is-backspace)))))))
- (set-terminal-parameter nil 'normal-erase-is-backspace
- (if enabled 1 0))
+ :variable (eq (terminal-parameter
+ nil 'normal-erase-is-backspace) 1)
+ (let ((enabled (eq 1 (terminal-parameter
+ nil 'normal-erase-is-backspace))))
(cond ((or (memq window-system '(x w32 ns pc))
(memq system-type '(ms-dos windows-nt)))
(let* ((bindings
- `(([C-delete] [C-backspace])
- ([M-delete] [M-backspace])
+ `(([M-delete] [M-backspace])
([C-M-delete] [C-M-backspace])
- (,esc-map
- [C-delete] [C-backspace])))
+ ([?\e C-delete] [?\e C-backspace])))
(old-state (lookup-key local-function-key-map [delete])))
(if enabled
(progn
(define-key local-function-key-map [delete] [?\C-d])
(define-key local-function-key-map [kp-delete] [?\C-d])
- (define-key local-function-key-map [backspace] [?\C-?]))
+ (define-key local-function-key-map [backspace] [?\C-?])
+ (dolist (b bindings)
+ ;; Not sure if input-decode-map is really right, but
+ ;; keyboard-translate-table (used below) only works
+ ;; for integer events, and key-translation-table is
+ ;; global (like the global-map, used earlier).
+ (define-key input-decode-map (car b) nil)
+ (define-key input-decode-map (cadr b) nil)))
(define-key local-function-key-map [delete] [?\C-?])
(define-key local-function-key-map [kp-delete] [?\C-?])
- (define-key local-function-key-map [backspace] [?\C-?]))
-
- ;; Maybe swap bindings of C-delete and C-backspace, etc.
- (unless (equal old-state (lookup-key local-function-key-map [delete]))
- (dolist (binding bindings)
- (let ((map global-map))
- (when (keymapp (car binding))
- (setq map (car binding) binding (cdr binding)))
- (let* ((key1 (nth 0 binding))
- (key2 (nth 1 binding))
- (binding1 (lookup-key map key1))
- (binding2 (lookup-key map key2)))
- (define-key map key1 binding2)
- (define-key map key2 binding1)))))))
+ (define-key local-function-key-map [backspace] [?\C-?])
+ (dolist (b bindings)
+ (define-key input-decode-map (car b) (cadr b))
+ (define-key input-decode-map (cadr b) (car b))))))
(t
(if enabled
(progn
(keyboard-translate ?\C-h ?\C-h)
(keyboard-translate ?\C-? ?\C-?))))
- (run-hooks 'normal-erase-is-backspace-hook)
- (if (interactive-p)
+ (if (called-interactively-p 'interactive)
(message "Delete key deletes %s"
- (if (terminal-parameter nil 'normal-erase-is-backspace)
+ (if (eq 1 (terminal-parameter nil 'normal-erase-is-backspace))
"forward" "backward")))))
\f
(defvar vis-mode-saved-buffer-invisibility-spec nil
turn it off.
Enabling Visible mode makes all invisible text temporarily visible.
-Disabling Visible mode turns off that effect. Visible mode
-works by saving the value of `buffer-invisibility-spec' and setting it to nil."
+Disabling Visible mode turns off that effect. Visible mode works by
+saving the value of `buffer-invisibility-spec' and setting it to nil."
:lighter " Vis"
:group 'editing-basics
(when (local-variable-p 'vis-mode-saved-buffer-invisibility-spec)
buffer-invisibility-spec)
(setq buffer-invisibility-spec nil)))
\f
+;; Partial application of functions (similar to "currying").
+;; This function is here rather than in subr.el because it uses CL.
+(defun apply-partially (fun &rest args)
+ "Return a function that is a partial application of FUN to ARGS.
+ARGS is a list of the first N arguments to pass to FUN.
+The result is a new function which does the same as FUN, except that
+the first N arguments are fixed at the values with which this function
+was called."
+ (lexical-let ((fun fun) (args1 args))
+ (lambda (&rest args2) (apply fun (append args1 args2)))))
+\f
;; Minibuffer prompt stuff.
;(defun minibuffer-prompt-modification (start end)
(boundp symbol)
(or (eq symbol t)
(and (stringp (setq symbol (eval symbol)))
- (string-match (nth 2 list) symbol)))
- (display-warning :warning (nth 3 list))))
+ (string-match-p (nth 2 list) symbol)))
+ (display-warning package (nth 3 list) :warning)))
(error nil)))
(mapc (lambda (elem)